diff --git a/Codec/Audio/MP3/Decoder.hs b/Codec/Audio/MP3/Decoder.hs new file mode 100644 --- /dev/null +++ b/Codec/Audio/MP3/Decoder.hs @@ -0,0 +1,301 @@ +-- +-- module Decoder - Decode MP3. +-- +-- This code is part of the Experimental Haskell MP3 Decoder, version 0.0.1. +-- Copyright (c) 2008 Bjorn Edstrom +-- +-- This software is provided 'as-is', without any express or implied +-- warranty. In no event will the authors be held liable for any damages +-- arising from the use of this software. +-- +-- Permission is granted to anyone to use this software for any purpose, +-- including commercial applications, and to alter it and redistribute it +-- freely, subject to the following restrictions: +-- +-- 1. The origin of this software must not be misrepresented; you must not +-- claim that you wrote the original software. If you use this software +-- in a product, an acknowledgment in the product documentation would be +-- appreciated but is not required. +-- +-- 2. Altered source versions must be plainly marked as such, and must not be +-- misrepresented as being the original software. +-- +-- 3. This notice may not be removed or altered from any source +-- distribution. +-- +-- TODO: +-- +-- *) Better performance. Right now the decoder is not fast enough to decode +-- in real-time. (Biggest culprit right now is the Huffman decoding). +-- +-- *) Check if frames with MixedBlocks are decoded correctly. This feature +-- seems to be unusual. +-- +-- *) Implement Intensity Stereo. Also unusual. +-- + +module Codec.Audio.MP3.Decoder ( + -- From MP3Unpack.hs + mp3Seek + ,mp3Unpack + ,MP3Bitstream(..) + -- From here + ,mp3Decode + ,MP3DecodeState(..) + ,emptyMP3DecodeState +) where + +import Codec.Audio.MP3.Unpack +import Codec.Audio.MP3.Types +import Codec.Audio.MP3.Tables +import Codec.Audio.MP3.HybridFilterBank + +-- +-- mp3Requantize +-- +-- The heart of mp3 encoding is taking the 576 frequency lines and quantize +-- the values to remove irrelevant information, while keeping enough data to +-- keep noise to the minimum. This function does the reverse: it takes the +-- quantized integer frequency samples and requantizes them to a floating +-- point representation. +-- +-- There are several parameters that affect the requantization: +-- +-- gain, sg0, sg1, sg2 are "global" gains that affect the whole +-- frequency spectra, from 0-576. gain are for long blocks of 576 samples, +-- and sg0-sg2 are for the three short blocks of 192 samples each. +-- +-- There are also "local" gains, that only scale some frequency regions. The +-- 576 frequency regions are divided in 21 bands (for long blocks), scaled +-- separately. The scale factors are saved in 'large' for long blocks and +-- 'small' for small blocks. +-- +-- *Codec.Audio.MP3.Tables> tableScaleBandIndexShort 32000 +-- [(0,0),(0,0),(0,0),(0,0),(0,1),(0,1),(0,1),(0,1),(0,2),(0,2),(0,2),(0,2), +-- (1,0),(1,0),(1,0),(1,0),(1,1),(1,1),(1,1),(1,1),(1,2),(1,2),(1,2),(1,2), +-- (2,0),(2,0),(2,0),(2,0),(2,1),(2,1),(2,1),(2,1),(2,2),(2,2),(2,2),(2,2), +-- (3,0),(3,0),(3,0),(3,0),... +-- +mp3Requantize :: SampleRate -> MP3DataChunk -> [Frequency] +mp3Requantize samplerate (MP3DataChunk _ bf gain (sg0, sg1, sg2) + longsf shortsf _ compressed) + | bf == LongBlocks = long + | bf == ShortBlocks = short + | bf == MixedBlocks = take 36 long ++ drop 36 short + where + long = zipWith procLong compressed longbands + short = zipWith procShort compressed shortbands + + procLong sample sfb = + let localgain = longsf !! sfb + dsample = fromIntegral sample + in gain * localgain * dsample **^ (4/3) + + procShort sample (sfb, win) = + let localgain = (shortsf !! sfb) !! win + blockgain = case win of 0 -> sg0 + 1 -> sg1 + 2 -> sg2 + dsample = fromIntegral sample + in gain * localgain * blockgain * dsample **^ (4/3) + + -- Frequency index (0-575) to scale factor band index (0-21). + longbands = tableScaleBandIndexLong samplerate + -- Frequency index to scale factor band index and window index (0-2). + shortbands = tableScaleBandIndexShort samplerate + + +-- b **^ e == sign(b) * abs(b)**e +(**^) :: (Floating a, Ord a) => a -> a -> a +b **^ e = let sign = if b < 0 then -1 else 1 + b' = abs b + in sign * b' ** e +infixr 8 **^ + + +-- +-- mp3Reorder +-- +-- The MP3 encoder reorders Short granules before Huffman coding for better +-- compression ratio. There are actually two different reorderings; +-- this function does both at the same time. +-- +-- The Huffman decoded samples (chunkData) are ordered first by +-- scale factor band, then by 192-granule, then by frequency. So if the +-- first scale factor band has size 4, the first 13 samples are +-- a[0],a[1],a[2],a[3],b[0],b[1],b[2],b[3],c[0],c[1],c[2],c[3],a[4],... +-- where a,b,c are the three 192-granules. +-- As samples within bands are quantized together, this gives a good +-- compression by the Huffman coder. +-- +-- As the hybrid filter bank works on 18 samples a time, and the scale +-- factor bands don't have this fixed size, the samples are reordered to +-- work with the filter banks. This can be thought of as two reorderings: +-- First the samples are interleaved, ordered strictly by frequency: +-- a[0],b[0],c[0],a[1],b[1],c[1],... This ensures the hybrid filter bank +-- can transform it back to the time domain, 18 samples a time. +-- +-- Then these samples are reordered again so the short IMDCT can be +-- performed on consecutive blocks of six samples. _This is strictly +-- for convienience_. If we don't do this second reordering, the +-- three short IMDCT's have to be done like this in the hybrid filter +-- bank: +-- imdct 6 [f!!0,f!!3,f!!6,f!!9,f!!12,f!!15] +-- imdct 6 [f!!1,f!!4,f!!7,f!!10,f!!13,f!!16] +-- imdct 6 [f!!2,f!!5,f!!8,f!!11,f!!14,f!!17] +-- After the seceond reordering, we can instead split "f" into three equal +-- parts, and do +-- imdct 6 f0 +-- for example. +-- +mp3Reorder :: SampleRate -> BlockFlag -> [Frequency] -> [Frequency] +mp3Reorder sr bf freq + | bf == LongBlocks = freq + | bf == ShortBlocks = freq' + | bf == MixedBlocks = take 36 freq ++ drop 36 freq' + where + -- We want the output list to be as long as the input list to + -- correctly handle IS Stereo decoding, but the unsafe reorderList + -- requires the input to be as long as the index list. + inlen = length freq + freq' = take inlen $ reorderList rtable (padWith 576 0.0 freq) + rtable = tableReorder sr + + +-- 'reorderList' takes a list of indices and a list of elements and +-- reorders the list based on the indices. Example: +-- reorderList [1,2,0] [a,b,c] == [b,c,a] +-- UNSAFE, SLOW +reorderList :: [Int] -> [a] -> [a] +reorderList indices list = map (list !!) indices + + +-- Pads a list until it's length is n. +-- padWith 5 0 [1,2,3] == [1,2,3,0,0] +padWith :: Int -> a -> [a] -> [a] +padWith n padding xs = xs ++ replicate (n - length xs) padding + + +-- +-- mp3StereoMS +-- +-- When two channels are similiar, the encoder can transmit the sum (M) +-- and the difference (S) of the two channels instead of the two independent +-- channels. In these cases, the sum signal will contain much more +-- information than the difference signal. This is lossless. +-- +mp3StereoMS :: [Frequency] -> [Frequency] -> ([Frequency], [Frequency]) +mp3StereoMS middle side = + let sqrtinv = 1 / (sqrt 2) + left = zipWith0 (\x y -> (x+y)*sqrtinv) 0.0 middle side + right = zipWith0 (\x y -> (x-y)*sqrtinv) 0.0 middle side + in (left, right) + + +zipWith0 :: (a -> a -> a) -> a -> [a] -> [a] -> [a] +zipWith0 f pad (a:as) (b:bs) = f a b : zipWith0 f pad as bs +zipWith0 f pad [] (b:bs) = f pad b : zipWith0 f pad [] bs +zipWith0 f pad (a:as) [] = f a pad : zipWith0 f pad as [] +zipWith0 _ _ _ _ = [] + + +-- +-- mp3StereoIS +-- +-- Another Joint Stereo mode. +-- +-- TODO: Not implemented yet - unusual. +-- +mp3StereoIS :: BlockFlag -> [Int] -> [[Int]] -> + [Frequency] -> [Frequency] -> ([Frequency], [Frequency]) +mp3StereoIS _ _ _ left right = (left, right) +{- +mp3StereoIS bf long short left right = helper bf + where + helper MixedBlocks = (left, right) -- TODO. + helper LongBlocks = (left, right) + helper ShortBlocks = (left, right) + + procOne 7 sl sr = (sl, sr) + procOne 6 sl sr = (sl, 0.0) + procOne p sl sr = let ratio = tan $ ((fromIntegral p) * pi) / 12.0 + ratiol = ratio / (1.0 + ratio) + ratior = 1.0 / (1.0 + ratio) + sl' = ratiol * sl + sr' = ratior * sr + in (sl', sr') +-} + +-- +-- mp3Decode +-- +-- Decode the MP3. +-- +-- Return value: +-- +-- 1152 samples (-1.0 - 1.0) for the left and right channel. +-- +-- TODO: Shouldn't need ~50 lines for this. +-- +mp3Decode :: MP3DecodeState -> MP3Data -> (MP3DecodeState, [Sample], [Sample]) +mp3Decode decstate chunks = decode chunks + where + decode (MP3Data2Channels sr ch (ms, is) gr0ch0 gr0ch1 gr1ch0 gr1ch1) = + let s00 = step0 gr0ch0 sr -- granule 0 begin + s01 = step0 gr0ch1 sr + (s00',s01') = decodeStereo ch gr0ch0 s00 gr0ch1 s01 + (state00, output00) = step1 gr0ch0 s00' (decodeState0 decstate) + (state01, output01) = step1 gr0ch1 s01' (decodeState1 decstate) + s10 = step0 gr1ch0 sr + s11 = step0 gr1ch1 sr + (s10', s11') = decodeStereo ch gr1ch0 s10 gr1ch1 s11 + (state10, output10) = step1 gr1ch0 s10' state00 + (state11, output11) = step1 gr1ch1 s11' state01 + in (MP3DecodeState state10 state11, + output00 ++ output10, output01 ++ output11) + where + decodeStereo JointStereo chunkch0 ch0 chunkch1 ch1 = + let bf0 = chunkBlockFlag chunkch0 + (isL, isS) = chunkISParam chunkch0 + (ch0', ch1') = + if ms then mp3StereoMS ch0 ch1 + else (ch0, ch1) + (ch0'', ch1'') = + if is then mp3StereoIS bf0 isL isS ch0' ch1' + else (ch0', ch1') + in (ch0'', ch1'') + decodeStereo _ _ ch0 _ ch1 = (ch0, ch1) + + decode (MP3Data1Channels sr _ _ gr0ch0 gr1ch0) = + let s00 = step0 gr0ch0 sr + s10 = step0 gr1ch0 sr + (state0, output0) = step1 gr0ch0 s00 (decodeState0 decstate) + (state1, output1) = step1 gr1ch0 s10 state0 + output = output0 ++ output1 + in (MP3DecodeState state1 state1, output, output) + + -- At this point the audio samples are _not_ padded with the zeros + -- from the zero huffman region. This is to make the IS stereo + -- implementation less messy. (Of course, IS is not implemented as of + -- version 0.0.1). + step0 chunk sr = + let freq = mp3Requantize sr chunk + freq' = mp3Reorder sr (chunkBlockFlag chunk) freq + in freq' + + -- ... The hybrid filter bank will however pad. + step1 chunk inp state = + let bf = chunkBlockFlag chunk + bt = chunkBlockType chunk + in mp3HybridFilterBank bf bt state inp + + +data MP3DecodeState = MP3DecodeState { + decodeState0 :: MP3HybridState, + decodeState1 :: MP3HybridState +} + + +emptyMP3DecodeState :: MP3DecodeState +emptyMP3DecodeState = MP3DecodeState emptyMP3HybridState emptyMP3HybridState + diff --git a/Codec/Audio/MP3/Huffman.hs b/Codec/Audio/MP3/Huffman.hs new file mode 100644 --- /dev/null +++ b/Codec/Audio/MP3/Huffman.hs @@ -0,0 +1,81 @@ +-- +-- module Huffman - Functions for dealing with Huffman +-- trees. This is not a full-fledged Huffman module +-- and has only limited functionality. +-- +-- This code is part of the Experimental Haskell MP3 Decoder, version 0.0.1. +-- Copyright (c) 2008 Bjorn Edstrom +-- +-- This software is provided 'as-is', without any express or implied +-- warranty. In no event will the authors be held liable for any damages +-- arising from the use of this software. +-- +-- Permission is granted to anyone to use this software for any purpose, +-- including commercial applications, and to alter it and redistribute it +-- freely, subject to the following restrictions: +-- +-- 1. The origin of this software must not be misrepresented; you must not +-- claim that you wrote the original software. If you use this software +-- in a product, an acknowledgment in the product documentation would be +-- appreciated but is not required. +-- +-- 2. Altered source versions must be plainly marked as such, and must not be +-- misrepresented as being the original software. +-- +-- 3. This notice may not be removed or altered from any source +-- distribution. +-- + +module Codec.Audio.MP3.Huffman ( + HuffmanTree(..) + ,huffmanFromList + ,huffmanLookupM +) where + +data HuffmanTree a = HuffmanNull + | HuffmanLeaf a + | HuffmanNode (HuffmanTree a) (HuffmanTree a) + deriving (Show, Eq) + +-- | 'huffmanFromList' builds a tree from a list representation of the tree. +-- The list is a [([Int], t)] where [Int] is a list of code bits and t is the +-- type of the value associated with the bits. Given the list +-- [([1],x), ([0,0,1],y), ([0,1],z), ([0,0,0],w)] +-- The function will construct the tree +-- HuffmanNode (HuffmanNode (HuffmanNode (HuffmanLeaf w) +-- (HuffmanLeaf y)) +-- (HuffmanLeaf z)) +-- (HuffmanLeaf x) +-- This is mainly useful if we have a table representation of a tree, +-- say from a technical specification. +huffmanFromList :: [([Int], t)] -> HuffmanTree t +huffmanFromList = foldl huffmanUpdate HuffmanNull + + +huffmanUpdate :: HuffmanTree t -> ([Int], t) -> HuffmanTree t +huffmanUpdate HuffmanNull ([], value) = HuffmanLeaf value +huffmanUpdate HuffmanNull (xs, value) = huffmanCreate xs value + where + huffmanCreate [] val = HuffmanLeaf val + huffmanCreate (y:ys) val = + if y == 0 then HuffmanNode (huffmanCreate ys val) HuffmanNull + else HuffmanNode HuffmanNull (huffmanCreate ys val) +huffmanUpdate (HuffmanNode left right) ((x:xs), value) = + if x == 0 then HuffmanNode (huffmanUpdate left (xs, value)) right + else HuffmanNode left (huffmanUpdate right (xs, value)) + + +-- | 'huffmanLookupM' looks up values in a tree. The first argument is a +-- monad action that decides whether to go left or right in the tree. +-- The second argument is the tree. The function returns error or +-- a pair with a value and number if bits consumed. +huffmanLookupM :: (Monad m) => m Bool -> HuffmanTree t -> m (Maybe (t, Int)) +huffmanLookupM getbitfunc tree = helper getbitfunc tree 0 + where + helper _ HuffmanNull _ = return Nothing + helper bf (HuffmanNode q0 q1) n = + do bit <- bf + r <- helper bf (if bit then q1 else q0) (n+1) + return $ r + helper _ (HuffmanLeaf leaf) n = return $ Just (leaf, n) + diff --git a/Codec/Audio/MP3/HybridFilterBank.hs b/Codec/Audio/MP3/HybridFilterBank.hs new file mode 100644 --- /dev/null +++ b/Codec/Audio/MP3/HybridFilterBank.hs @@ -0,0 +1,223 @@ +-- +-- module HybridFilterBank - Frequency to time. +-- +-- This code is part of the Experimental Haskell MP3 Decoder, version 0.0.1. +-- Copyright (c) 2008 Bjorn Edstrom +-- +-- This software is provided 'as-is', without any express or implied +-- warranty. In no event will the authors be held liable for any damages +-- arising from the use of this software. +-- +-- Permission is granted to anyone to use this software for any purpose, +-- including commercial applications, and to alter it and redistribute it +-- freely, subject to the following restrictions: +-- +-- 1. The origin of this software must not be misrepresented; you must not +-- claim that you wrote the original software. If you use this software +-- in a product, an acknowledgment in the product documentation would be +-- appreciated but is not required. +-- +-- 2. Altered source versions must be plainly marked as such, and must not be +-- misrepresented as being the original software. +-- +-- 3. This notice may not be removed or altered from any source +-- distribution. +-- + +module Codec.Audio.MP3.HybridFilterBank ( + mp3HybridFilterBank + ,MP3HybridState(..) + ,emptyMP3HybridState +) where + +import Codec.Audio.MP3.IMDCT +import Codec.Audio.MP3.SynthesisFilterBank +import Codec.Audio.MP3.Tables +import Codec.Audio.MP3.Types + +{- +mapBlock :: Int -> ([a] -> [b]) -> [a] -> [b] +mapBlock blocksize func [] = [] +mapBlock blocksize func seq = + let (block, rem) = splitAt blocksize seq + in func block ++ mapBlock blocksize func rem +-} + +mapBlock :: Int -> ([a] -> b) -> [a] -> [b] +mapBlock blocksize func [] = [] +mapBlock blocksize func seq = + let (block, rem) = splitAt blocksize seq + in func block : mapBlock blocksize func rem + + +-- 'windowWith' windows two signals. For readability, so we can do: +-- signal' = signal `windowWith` win +windowWith :: (Num a) => [a] -> [a] -> [a] +windowWith = zipWith (*) + + +-- +-- mp3IMDCT +-- +-- Input: 576 frequency samples and state from the last time the function +-- was called. +-- Output: 576 time domain samples and new state. +-- +mp3IMDCT :: BlockFlag -> Int -> [Frequency] -> [Sample] -> ([Sample], [Sample]) +mp3IMDCT blockflag blocktype freq overlap = + let (samples, overlap') = + case blockflag of + LongBlocks -> transf (doImdctLong blocktype) freq + ShortBlocks -> transf (doImdctShort) freq + MixedBlocks -> transf (doImdctLong 0) (take 36 freq) <++> + transf (doImdctShort) (drop 36 freq) + samples' = zipWith (+) samples overlap + in (samples', overlap') + where + transf imdctfunc input = unzipConcat $ mapBlock 18 toSO input + where + -- toSO takes 18 input samples b and computes 36 time samples + -- by the IMDCT. These are further divided into two equal + -- parts (S, O) where S are time samples for this frame + -- and O are values to be overlapped in the next frame. + toSO b = splitAt 18 (imdctfunc b) + unzipConcat xs = let (a, b) = unzip xs + in (concat a, concat b) + +-- +-- doImdctLong, doImdctShort +-- +-- IMDCT with windows. This also does the overlapping when short blocks +-- are used. +-- +doImdctLong :: Int -> [Frequency] -> [Sample] +doImdctLong blocktype f = imdct 18 f `windowWith` tableImdctWindow blocktype + + +doImdctShort :: [Frequency] -> [Sample] +doImdctShort f = overlap3 shorta shortb shortc + where + (f1, f2, f3) = splitAt2 6 f + shorta = imdct 6 f1 `windowWith` tableImdctWindow 2 + shortb = imdct 6 f2 `windowWith` tableImdctWindow 2 + shortc = imdct 6 f3 `windowWith` tableImdctWindow 2 + --shorta = imdct 6 [f!!0,f!!3,f!!6,f!!9,f!!12,f!!15] `windowWith` tableImdctWindow 2 + --shortb = imdct 6 [f!!1,f!!4,f!!7,f!!10,f!!13,f!!16] `windowWith` tableImdctWindow 2 + --shortc = imdct 6 [f!!2,f!!5,f!!8,f!!11,f!!14,f!!17] `windowWith` tableImdctWindow 2 + + overlap3 a b c = + p1 ++ (zipWith3 add3 (a ++ p2) (p1 ++ b ++ p1) (p2 ++ c)) ++ p1 + where + add3 x y z = x+y+z + p1 = [0,0,0, 0,0,0] + p2 = [0,0,0, 0,0,0, 0,0,0, 0,0,0] + + +splitAt2 :: Int -> [a] -> ([a], [a], [a]) +splitAt2 n xs = let (part1, part23) = splitAt n xs + (part2, part3) = splitAt n part23 + in (part1, part2, part3) + +(<++>) :: ([a], [b]) -> ([a], [b]) -> ([a], [b]) +(as, xs) <++> (bs, ys) = (as++bs, xs++ys) +infixr 5 <++> + + +-- +-- mp3AA +-- +-- Undo the encoders alias reduction. +-- +-- TODO: Rewrite this, clumsy and non-intuitive. +-- +mp3AA :: BlockFlag -> Int -> [Frequency] -> [Frequency] +mp3AA blockflag blocktype freq + | blocktype == 2 && blockflag /= MixedBlocks = freq + | blocktype == 2 && blockflag == MixedBlocks = + (take 9 freq) ++ aaHelper (take 18 (drop 9 freq)) ++ (drop 27 freq) + | otherwise = + (take 9 freq) ++ aaHelper (take 558 (drop 9 freq)) ++ (drop 567 freq) + where + aaHelper [] = [] + aaHelper chunk = before ++ aaButterfly middle ++ after ++ + aaHelper (drop 18 chunk) + where + before = take 1 chunk + middle = take 16 (drop 1 chunk) + after = take 1 (drop 17 chunk) + aaButterfly f = zipWith (-) (take 8 seqcs) (take 8 seqca) ++ + zipWith (+) (drop 8 seqcs) (drop 8 seqca) + where + seqcs = zipWith (*) f (reverse cs ++ cs) + seqca = reverse $ zipWith (*) f (reverse ca ++ ca) + cs = [1 / sqrt (1.0 + c**2) | c <- aaCoeff] + ca = [c / sqrt (1.0 + c**2) | c <- aaCoeff] + aaCoeff = [-0.6, -0.535, -0.33, -0.185, + -0.095, -0.041, -0.0142, -0.0037] + + +{- +mp3AliasCancel :: BlockFlag -> [Frequency] -> [Frequency] +mp3AliasCancel blockflag freq + | blockflag == ShortBlocks = freq + | blockflag == LongBlocks = helper 31 + | blockflag == MixedBlocks = helper 1 + where + butterflies samples = let samplesa = zipWith (*) samples cs' + samplesb = zipWith (*) (reverse samples) ca' + in zipWith (+) samplesa samplesb + -- Coeffs. + cs' = reverse cs ++ cs + ca' = map (-) (reverse ca) ++ ca + cs = [1 / sqrt (1.0 + c**2) | c <- aaCoeff] + ca = [c / sqrt (1.0 + c**2) | c <- aaCoeff] + aaCoeff = [-0.6, -0.535, -0.33, -0.185, -0.095, -0.041, -0.0142, -0.0037] +-} + +-- +-- mp3FrequencyInvert +-- +-- The time samples returned from mp3IMDCT are inverted. This is the same +-- as with bandpass sampling: odd subbands have inverted frequency spectra - +-- invert it by changing signs on odd samples. +-- +mp3FrequencyInvert :: [Sample] -> [Sample] +mp3FrequencyInvert = zipWith (*) pattern + where + pattern = cycle $ replicate 18 1 ++ take 18 (cycle [1,-1]) + + +-- Pads a list until it's length is n. +-- padWith 5 0 [1,2,3] == [1,2,3,0,0] +padWith :: Int -> a -> [a] -> [a] +padWith n padding xs = xs ++ replicate (n - length xs) padding + + +-- +-- mp3HybridFilterBank +-- +-- Frequency domain to time domain. +-- +mp3HybridFilterBank :: BlockFlag -> Int -> + MP3HybridState -> [Frequency] -> + (MP3HybridState, [Sample]) +mp3HybridFilterBank bf bt (MP3HybridState simdct ssynthesis) input = + let input' = padWith 576 0.0 input -- ensure length 576 + aa = mp3AA bf bt input' + (samp, simdct') = mp3IMDCT bf bt aa simdct + samp' = mp3FrequencyInvert samp + + --(ssynthesis', output) = (ssynthesis, take 18 samp) -- (See Driver.hs) + (ssynthesis', output) = mp3SynthesisFilterBank ssynthesis samp' + + in (MP3HybridState simdct' ssynthesis', output) + + +-- [Sample] = IMDCT output from previous granule, used for overlapping. +-- MP3SynthState = State for the synthesis filterbank. +data MP3HybridState = MP3HybridState [Sample] MP3SynthState + +emptyMP3HybridState :: MP3HybridState +emptyMP3HybridState = MP3HybridState (replicate 576 0.0) + (MP3SynthState (replicate 1024 0.0)) + diff --git a/Codec/Audio/MP3/IMDCT.hs b/Codec/Audio/MP3/IMDCT.hs new file mode 100644 --- /dev/null +++ b/Codec/Audio/MP3/IMDCT.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +-- +-- module IMDCT +-- +-- This code is part of the Experimental Haskell MP3 Decoder, version 0.0.1. +-- Copyright (c) 2008 Bjorn Edstrom +-- +-- This software is provided 'as-is', without any express or implied +-- warranty. In no event will the authors be held liable for any damages +-- arising from the use of this software. +-- +-- Permission is granted to anyone to use this software for any purpose, +-- including commercial applications, and to alter it and redistribute it +-- freely, subject to the following restrictions: +-- +-- 1. The origin of this software must not be misrepresented; you must not +-- claim that you wrote the original software. If you use this software +-- in a product, an acknowledgment in the product documentation would be +-- appreciated but is not required. +-- +-- 2. Altered source versions must be plainly marked as such, and must not be +-- misrepresented as being the original software. +-- +-- 3. This notice may not be removed or altered from any source +-- distribution. +-- +module Codec.Audio.MP3.IMDCT ( + imdct +) where + +import Foreign.C.Types +import Foreign.Ptr +import Foreign.Marshal.Array +import System.IO.Unsafe + + +foreign import ccall "c_imdct.h imdct" + c_imdct :: CInt -> + Ptr CDouble -> + Ptr CDouble -> + IO () + +imdctIO :: Int -> [CDouble] -> IO [CDouble] +imdctIO points input + = withArray input $ \cinput -> + allocaArray (points*2) $ \coutput -> + do c_imdct (fromIntegral points) cinput coutput + peekArray (points*2) coutput + + +imdct :: Int -> [Double] -> [Double] +imdct points input = let cinput = map realToFrac input + coutput = unsafePerformIO (imdctIO points cinput) + output = map realToFrac coutput + in output + diff --git a/Codec/Audio/MP3/SynthesisFilterBank.hs b/Codec/Audio/MP3/SynthesisFilterBank.hs new file mode 100644 --- /dev/null +++ b/Codec/Audio/MP3/SynthesisFilterBank.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +-- +-- module SynthesisFilterBank - The MPEG synthesis filterbank. +-- +-- This code is part of the Experimental Haskell MP3 Decoder, version 0.0.1. +-- Copyright (c) 2008 Bjorn Edstrom +-- +-- This software is provided 'as-is', without any express or implied +-- warranty. In no event will the authors be held liable for any damages +-- arising from the use of this software. +-- +-- Permission is granted to anyone to use this software for any purpose, +-- including commercial applications, and to alter it and redistribute it +-- freely, subject to the following restrictions: +-- +-- 1. The origin of this software must not be misrepresented; you must not +-- claim that you wrote the original software. If you use this software +-- in a product, an acknowledgment in the product documentation would be +-- appreciated but is not required. +-- +-- 2. Altered source versions must be plainly marked as such, and must not be +-- misrepresented as being the original software. +-- +-- 3. This notice may not be removed or altered from any source +-- distribution. +-- + +module Codec.Audio.MP3.SynthesisFilterBank ( + MP3SynthState(..) + ,mp3SynthesisFilterBank +) where + +import Foreign.C.Types +import Foreign.Ptr +import Foreign.Marshal.Array +import System.IO.Unsafe + +foreign import ccall "c_synth.h synth" + c_synth :: Ptr CDouble -> + Ptr CDouble -> + Ptr CDouble -> + Ptr CDouble -> + IO () + +synthIO :: [CDouble] -> [CDouble] -> IO ([CDouble], [CDouble]) +synthIO state input + = withArray state $ \cstate -> + withArray input $ \cinput -> + allocaArray 1024 $ \cstate' -> + allocaArray 576 $ \coutput -> + do c_synth cstate cinput cstate' coutput + state' <- peekArray 1024 cstate' + output <- peekArray 576 coutput + return (state', output) + +data MP3SynthState = MP3SynthState [Sample] deriving (Show) + +type Sample = Double +mp3SynthesisFilterBank :: MP3SynthState -> [Sample] -> + (MP3SynthState, [Sample]) +mp3SynthesisFilterBank (MP3SynthState state) input = + let cstate = map realToFrac state + cinput = map realToFrac input + (cstate', coutput) = unsafePerformIO (synthIO cstate cinput) + state' = map realToFrac cstate' + output = map realToFrac coutput + in (MP3SynthState state', output) + diff --git a/Codec/Audio/MP3/Tables.hs b/Codec/Audio/MP3/Tables.hs new file mode 100644 --- /dev/null +++ b/Codec/Audio/MP3/Tables.hs @@ -0,0 +1,1889 @@ +-- +-- module Tables - Tables defined in the specification. +-- +-- This code is part of the Experimental Haskell MP3 Decoder, version 0.0.1. +-- Copyright (c) 2008 Bjorn Edstrom +-- +-- This software is provided 'as-is', without any express or implied +-- warranty. In no event will the authors be held liable for any damages +-- arising from the use of this software. +-- +-- Permission is granted to anyone to use this software for any purpose, +-- including commercial applications, and to alter it and redistribute it +-- freely, subject to the following restrictions: +-- +-- 1. The origin of this software must not be misrepresented; you must not +-- claim that you wrote the original software. If you use this software +-- in a product, an acknowledgment in the product documentation would be +-- appreciated but is not required. +-- +-- 2. Altered source versions must be plainly marked as such, and must not be +-- misrepresented as being the original software. +-- +-- 3. This notice may not be removed or altered from any source +-- distribution. +-- +-- TODO: Change all tables to something more suitable with O(1) lookup. +-- +module Codec.Audio.MP3.Tables ( + tableImdctWindow + ,tableScaleBandBoundary + ,tableScaleBandIndexLong + ,tableScaleBandIndexShort + ,tableSlen + ,tableReorder + ,tableReorder2 -- See below. + ,tablePretab + ,tableHuffman + ,tableHuffmanQuad +) where + +-- +-- tableImdctWindow +-- +-- Window coefficients for IMDCT transform. +-- +tableImdctWindow :: Floating a => Int -> [a] +tableImdctWindow blocktype + | blocktype == 0 = [coeff n 36 0.5 | n <- [ 0..35]] + | blocktype == 1 = [coeff n 36 0.5 | n <- [ 0..17]] ++ + [1.0 | n <- [18..23]] ++ + [coeff n 12 (-17.5) | n <- [24..29]] ++ + [0.0 | n <- [30..35]] + | blocktype == 2 = [coeff n 12 0.5 | n <- [ 0..11]] ++ + [0.0 | n <- [12..35]] + | blocktype == 3 = [0.0 | n <- [ 0.. 5]] ++ + [coeff n 12 (-5.5) | n <- [ 6..11]] ++ + [1.0 | n <- [12..17]] ++ + [coeff n 36 0.5 | n <- [18..35]] + | otherwise = error "Wrong blocktype." + where + coeff n div' add' = sin (pi/div' * ((fromIntegral n) + add')) + +-- +-- tableScaleBandBound{Long,Short}, tableScaleBandBoundary +-- +-- These few tables represent the boundaries, in the 576 frequency +-- regions, of the scale factor bands. These bands approximate the +-- critical bands of the human auditory system, and are used to +-- determine scaling. This scaling controls the quantization noise. +-- +tableScaleBandBoundLong :: Int -> [Int] +tableScaleBandBoundLong 44100 = [ 0, 4, 8, 12, 16, 20, 24, 30, + 36, 44, 52, 62, 74, 90, 110, 134, + 162, 196, 238, 288, 342, 418, 576] +tableScaleBandBoundLong 48000 = [ 0, 4, 8, 12, 16, 20, 24, 30, + 36, 42, 50, 60, 72, 88, 106, 128, + 156, 190, 230, 276, 330, 384, 576] +tableScaleBandBoundLong 32000 = [ 0, 4, 8, 12, 16, 20, 24, 30, + 36, 44, 54, 66, 82, 102, 126, 156, + 194, 240, 296, 364, 448, 550, 576] +tableScaleBandBoundLong _ = error "Wrong SR for Table." + + +tableScaleBandBoundShort :: Int -> [Int] +tableScaleBandBoundShort 44100 = [ 0, 4, 8, 12, 16, 22, 30, 40, + 52, 66, 84, 106, 136, 192] +tableScaleBandBoundShort 48000 = [ 0, 4, 8, 12, 16, 22, 28, 38, + 50, 64, 80, 100, 126, 192] +tableScaleBandBoundShort 32000 = [ 0, 4, 8, 12, 16, 22, 30, 42, + 58, 78, 104, 138, 180, 192] +tableScaleBandBoundShort _ = error "Wrong SR for Table." + +-- We only need to export the long boundaries for unpacking (Unpack.hs). +tableScaleBandBoundary :: Int -> Int -> Int +tableScaleBandBoundary sfreq index = (tableScaleBandBoundLong sfreq) !! index + + +-- +-- tableScaleBandIndex{Long,Short} +-- +-- Long: The scale factor band indices. As the first band has length 4, this +-- gives [0,0,0,0,1,...] which simply means sample 0-3 belong to scale factor +-- band 0. +-- +-- Short: The scale factor band indices + 192-granule indices. Due to the +-- encoders reordering, this gives [(0,0),(0,0),(0,0),(0,0),(0,1),... +-- This means sample 0 (of the 576) belongs to scale factor band 0, and the +-- first of the three 192-granules. +-- + +tableScaleBandIndexLong :: Int -> [Int] +tableScaleBandIndexLong = indexify . + consecutiveDiff . tableScaleBandBoundLong + where + indexify xs = concat (zipWith replicate xs [0..]) + + +tableScaleBandIndexShort :: Int -> [(Int, Int)] +tableScaleBandIndexShort = indexifyWindows . + consecutiveDiff . tableScaleBandBoundShort + where + indexifyWindows xs = concat (zipWith addFirst [0..] (map buildTriple xs)) + where + addFirst n = map (\x -> (n, x)) + buildTriple n = replicate n 0 ++ replicate n 1 ++ replicate n 2 + + +consecutiveDiff :: Num a => [a] -> [a] +consecutiveDiff xs = zipWith (-) (tail xs) xs + +-- +-- tablePretab +-- +-- Modifies certain scale factors for higher range than 4 bits. +-- +tablePretab :: [Int] +tablePretab = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 1, 1, 1, 1, 2, 2, 3, 3, 3, 2, 0, 0] + + +-- +-- tableSlen +-- +-- This table is used for parsing the scale factor bands. +-- +tableSlen :: [(Int, Int)] +tableSlen = [(0,0), (0,1), (0,2), (0,3), (3,0), (1,1), (1,2), (1,3), + (2,1), (2,2), (2,3), (3,1) ,(3,2), (3,3), (4,2), (4,3)] + + +-- +-- tableReorder +-- +-- Before Huffman coding the encoder reorders short chunks for better +-- compression. This does two reorderings; see Decoder.hs. +-- +tableReorder :: Int -> [Int] +tableReorder 44100 = + [ 0, 1, 2, 3, 12, 13, 4, 5, 6, 7, 16, 17, 8, 9, 10, 11, 20, 21, + 14, 15, 24, 25, 26, 27, 18, 19, 28, 29, 30, 31, 22, 23, 32, 33, 34, 35, + 36, 37, 38, 39, 48, 49, 40, 41, 42, 43, 54, 55, 44, 45, 46, 47, 60, 61, + 50, 51, 52, 53, 66, 67, 56, 57, 58, 59, 74, 75, 62, 63, 64, 65, 82, 83, + 68, 69, 70, 71, 72, 73, 76, 77, 78, 79, 80, 81, 84, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, 95, 100, 101, 102, 103, 104, 105, 110, 111, 112, 113, 114, 115, + 96, 97, 98, 99, 120, 121, 106, 107, 108, 109, 132, 133, 116, 117, 118, 119, 144, 145, + 122, 123, 124, 125, 126, 127, 134, 135, 136, 137, 138, 139, 146, 147, 148, 149, 150, 151, + 128, 129, 130, 131, 156, 157, 140, 141, 142, 143, 170, 171, 152, 153, 154, 155, 184, 185, + 158, 159, 160, 161, 162, 163, 172, 173, 174, 175, 176, 177, 186, 187, 188, 189, 190, 191, + 164, 165, 166, 167, 168, 169, 178, 179, 180, 181, 182, 183, 192, 193, 194, 195, 196, 197, + 198, 199, 200, 201, 202, 203, 216, 217, 218, 219, 220, 221, 234, 235, 236, 237, 238, 239, + 204, 205, 206, 207, 208, 209, 222, 223, 224, 225, 226, 227, 240, 241, 242, 243, 244, 245, + 210, 211, 212, 213, 214, 215, 228, 229, 230, 231, 232, 233, 246, 247, 248, 249, 250, 251, + 252, 253, 254, 255, 256, 257, 274, 275, 276, 277, 278, 279, 296, 297, 298, 299, 300, 301, + 258, 259, 260, 261, 262, 263, 280, 281, 282, 283, 284, 285, 302, 303, 304, 305, 306, 307, + 264, 265, 266, 267, 268, 269, 286, 287, 288, 289, 290, 291, 308, 309, 310, 311, 312, 313, + 270, 271, 272, 273, 318, 319, 292, 293, 294, 295, 348, 349, 314, 315, 316, 317, 378, 379, + 320, 321, 322, 323, 324, 325, 350, 351, 352, 353, 354, 355, 380, 381, 382, 383, 384, 385, + 326, 327, 328, 329, 330, 331, 356, 357, 358, 359, 360, 361, 386, 387, 388, 389, 390, 391, + 332, 333, 334, 335, 336, 337, 362, 363, 364, 365, 366, 367, 392, 393, 394, 395, 396, 397, + 338, 339, 340, 341, 342, 343, 368, 369, 370, 371, 372, 373, 398, 399, 400, 401, 402, 403, + 344, 345, 346, 347, 408, 409, 374, 375, 376, 377, 464, 465, 404, 405, 406, 407, 520, 521, + 410, 411, 412, 413, 414, 415, 466, 467, 468, 469, 470, 471, 522, 523, 524, 525, 526, 527, + 416, 417, 418, 419, 420, 421, 472, 473, 474, 475, 476, 477, 528, 529, 530, 531, 532, 533, + 422, 423, 424, 425, 426, 427, 478, 479, 480, 481, 482, 483, 534, 535, 536, 537, 538, 539, + 428, 429, 430, 431, 432, 433, 484, 485, 486, 487, 488, 489, 540, 541, 542, 543, 544, 545, + 434, 435, 436, 437, 438, 439, 490, 491, 492, 493, 494, 495, 546, 547, 548, 549, 550, 551, + 440, 441, 442, 443, 444, 445, 496, 497, 498, 499, 500, 501, 552, 553, 554, 555, 556, 557, + 446, 447, 448, 449, 450, 451, 502, 503, 504, 505, 506, 507, 558, 559, 560, 561, 562, 563, + 452, 453, 454, 455, 456, 457, 508, 509, 510, 511, 512, 513, 564, 565, 566, 567, 568, 569, + 458, 459, 460, 461, 462, 463, 514, 515, 516, 517, 518, 519, 570, 571, 572, 573, 574, 575] + +tableReorder 48000 = + [ 0, 1, 2, 3, 12, 13, 4, 5, 6, 7, 16, 17, 8, 9, 10, 11, 20, 21, + 14, 15, 24, 25, 26, 27, 18, 19, 28, 29, 30, 31, 22, 23, 32, 33, 34, 35, + 36, 37, 38, 39, 48, 49, 40, 41, 42, 43, 54, 55, 44, 45, 46, 47, 60, 61, + 50, 51, 52, 53, 66, 67, 56, 57, 58, 59, 72, 73, 62, 63, 64, 65, 78, 79, + 68, 69, 70, 71, 84, 85, 74, 75, 76, 77, 94, 95, 80, 81, 82, 83, 104, 105, + 86, 87, 88, 89, 90, 91, 96, 97, 98, 99, 100, 101, 106, 107, 108, 109, 110, 111, + 92, 93, 114, 115, 116, 117, 102, 103, 126, 127, 128, 129, 112, 113, 138, 139, 140, 141, + 118, 119, 120, 121, 122, 123, 130, 131, 132, 133, 134, 135, 142, 143, 144, 145, 146, 147, + 124, 125, 150, 151, 152, 153, 136, 137, 164, 165, 166, 167, 148, 149, 178, 179, 180, 181, + 154, 155, 156, 157, 158, 159, 168, 169, 170, 171, 172, 173, 182, 183, 184, 185, 186, 187, + 160, 161, 162, 163, 192, 193, 174, 175, 176, 177, 208, 209, 188, 189, 190, 191, 224, 225, + 194, 195, 196, 197, 198, 199, 210, 211, 212, 213, 214, 215, 226, 227, 228, 229, 230, 231, + 200, 201, 202, 203, 204, 205, 216, 217, 218, 219, 220, 221, 232, 233, 234, 235, 236, 237, + 206, 207, 240, 241, 242, 243, 222, 223, 260, 261, 262, 263, 238, 239, 280, 281, 282, 283, + 244, 245, 246, 247, 248, 249, 264, 265, 266, 267, 268, 269, 284, 285, 286, 287, 288, 289, + 250, 251, 252, 253, 254, 255, 270, 271, 272, 273, 274, 275, 290, 291, 292, 293, 294, 295, + 256, 257, 258, 259, 300, 301, 276, 277, 278, 279, 326, 327, 296, 297, 298, 299, 352, 353, + 302, 303, 304, 305, 306, 307, 328, 329, 330, 331, 332, 333, 354, 355, 356, 357, 358, 359, + 308, 309, 310, 311, 312, 313, 334, 335, 336, 337, 338, 339, 360, 361, 362, 363, 364, 365, + 314, 315, 316, 317, 318, 319, 340, 341, 342, 343, 344, 345, 366, 367, 368, 369, 370, 371, + 320, 321, 322, 323, 324, 325, 346, 347, 348, 349, 350, 351, 372, 373, 374, 375, 376, 377, + 378, 379, 380, 381, 382, 383, 444, 445, 446, 447, 448, 449, 510, 511, 512, 513, 514, 515, + 384, 385, 386, 387, 388, 389, 450, 451, 452, 453, 454, 455, 516, 517, 518, 519, 520, 521, + 390, 391, 392, 393, 394, 395, 456, 457, 458, 459, 460, 461, 522, 523, 524, 525, 526, 527, + 396, 397, 398, 399, 400, 401, 462, 463, 464, 465, 466, 467, 528, 529, 530, 531, 532, 533, + 402, 403, 404, 405, 406, 407, 468, 469, 470, 471, 472, 473, 534, 535, 536, 537, 538, 539, + 408, 409, 410, 411, 412, 413, 474, 475, 476, 477, 478, 479, 540, 541, 542, 543, 544, 545, + 414, 415, 416, 417, 418, 419, 480, 481, 482, 483, 484, 485, 546, 547, 548, 549, 550, 551, + 420, 421, 422, 423, 424, 425, 486, 487, 488, 489, 490, 491, 552, 553, 554, 555, 556, 557, + 426, 427, 428, 429, 430, 431, 492, 493, 494, 495, 496, 497, 558, 559, 560, 561, 562, 563, + 432, 433, 434, 435, 436, 437, 498, 499, 500, 501, 502, 503, 564, 565, 566, 567, 568, 569, + 438, 439, 440, 441, 442, 443, 504, 505, 506, 507, 508, 509, 570, 571, 572, 573, 574, 575] + +tableReorder 32000 = + [ 0, 1, 2, 3, 12, 13, 4, 5, 6, 7, 16, 17, 8, 9, 10, 11, 20, 21, + 14, 15, 24, 25, 26, 27, 18, 19, 28, 29, 30, 31, 22, 23, 32, 33, 34, 35, + 36, 37, 38, 39, 48, 49, 40, 41, 42, 43, 54, 55, 44, 45, 46, 47, 60, 61, + 50, 51, 52, 53, 66, 67, 56, 57, 58, 59, 74, 75, 62, 63, 64, 65, 82, 83, + 68, 69, 70, 71, 72, 73, 76, 77, 78, 79, 80, 81, 84, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, 95, 102, 103, 104, 105, 106, 107, 114, 115, 116, 117, 118, 119, + 96, 97, 98, 99, 100, 101, 108, 109, 110, 111, 112, 113, 120, 121, 122, 123, 124, 125, + 126, 127, 128, 129, 130, 131, 142, 143, 144, 145, 146, 147, 158, 159, 160, 161, 162, 163, + 132, 133, 134, 135, 136, 137, 148, 149, 150, 151, 152, 153, 164, 165, 166, 167, 168, 169, + 138, 139, 140, 141, 174, 175, 154, 155, 156, 157, 194, 195, 170, 171, 172, 173, 214, 215, + 176, 177, 178, 179, 180, 181, 196, 197, 198, 199, 200, 201, 216, 217, 218, 219, 220, 221, + 182, 183, 184, 185, 186, 187, 202, 203, 204, 205, 206, 207, 222, 223, 224, 225, 226, 227, + 188, 189, 190, 191, 192, 193, 208, 209, 210, 211, 212, 213, 228, 229, 230, 231, 232, 233, + 234, 235, 236, 237, 238, 239, 260, 261, 262, 263, 264, 265, 286, 287, 288, 289, 290, 291, + 240, 241, 242, 243, 244, 245, 266, 267, 268, 269, 270, 271, 292, 293, 294, 295, 296, 297, + 246, 247, 248, 249, 250, 251, 272, 273, 274, 275, 276, 277, 298, 299, 300, 301, 302, 303, + 252, 253, 254, 255, 256, 257, 278, 279, 280, 281, 282, 283, 304, 305, 306, 307, 308, 309, + 258, 259, 312, 313, 314, 315, 284, 285, 346, 347, 348, 349, 310, 311, 380, 381, 382, 383, + 316, 317, 318, 319, 320, 321, 350, 351, 352, 353, 354, 355, 384, 385, 386, 387, 388, 389, + 322, 323, 324, 325, 326, 327, 356, 357, 358, 359, 360, 361, 390, 391, 392, 393, 394, 395, + 328, 329, 330, 331, 332, 333, 362, 363, 364, 365, 366, 367, 396, 397, 398, 399, 400, 401, + 334, 335, 336, 337, 338, 339, 368, 369, 370, 371, 372, 373, 402, 403, 404, 405, 406, 407, + 340, 341, 342, 343, 344, 345, 374, 375, 376, 377, 378, 379, 408, 409, 410, 411, 412, 413, + 414, 415, 416, 417, 418, 419, 456, 457, 458, 459, 460, 461, 498, 499, 500, 501, 502, 503, + 420, 421, 422, 423, 424, 425, 462, 463, 464, 465, 466, 467, 504, 505, 506, 507, 508, 509, + 426, 427, 428, 429, 430, 431, 468, 469, 470, 471, 472, 473, 510, 511, 512, 513, 514, 515, + 432, 433, 434, 435, 436, 437, 474, 475, 476, 477, 478, 479, 516, 517, 518, 519, 520, 521, + 438, 439, 440, 441, 442, 443, 480, 481, 482, 483, 484, 485, 522, 523, 524, 525, 526, 527, + 444, 445, 446, 447, 448, 449, 486, 487, 488, 489, 490, 491, 528, 529, 530, 531, 532, 533, + 450, 451, 452, 453, 454, 455, 492, 493, 494, 495, 496, 497, 534, 535, 536, 537, 538, 539, + 540, 541, 542, 543, 544, 545, 552, 553, 554, 555, 556, 557, 564, 565, 566, 567, 568, 569, + 546, 547, 548, 549, 550, 551, 558, 559, 560, 561, 562, 563, 570, 571, 572, 573, 574, 575] + +tableReorder _ = error "Wrong SR for Table." + +-- +-- tableReorder2 +-- +-- This table does only one reordering. If we do this, we have to +-- imdct 6 [f!!0,f!!3,f!!6,f!!9,f!!12,f!!15] (see Decoder.hs) +-- +tableReorder2 :: Int -> [Int] +tableReorder2 44100 = tab1 +tableReorder2 48000 = tab2 +tableReorder2 32000 = tab3 +tableReorder2 _ = error "Wrong SR for Table." + +-- The scale factor bandwidth for the first band in a short 192-granule is 4, +-- so the first 12 samples are the first 4 samples, interleaved. +tab1 :: [Int] +tab1 = [0, 4, 8, 1, 5, 9, 2, 6, 10, 3, 7, 11, + 12, 16, 20, 13, + 17, 21, 14, 18, 22, 15, 19, 23, 24, 28, 32, 25, 29, 33, 26, + 30, 34, 27, 31, 35, 36, 40, 44, 37, 41, 45, 38, 42, 46, 39, + 43, 47, 48, 54, 60, 49, 55, 61, 50, 56, 62, 51, 57, 63, 52, + 58, 64, 53, 59, 65, 66, 74, 82, 67, 75, 83, 68, 76, 84, 69, + 77, 85, 70, 78, 86, 71, 79, 87, 72, 80, 88, 73, 81, 89, 90, + 100, 110, 91, 101, 111, 92, 102, 112, 93, 103, 113, 94, 104, 114, 95, + 105, 115, 96, 106, 116, 97, 107, 117, 98, 108, 118, 99, 109, 119, 120, + 132, 144, 121, 133, 145, 122, 134, 146, 123, 135, 147, 124, 136, 148, 125, + 137, 149, 126, 138, 150, 127, 139, 151, 128, 140, 152, 129, 141, 153, 130, + 142, 154, 131, 143, 155, 156, 170, 184, 157, 171, 185, 158, 172, 186, 159, + 173, 187, 160, 174, 188, 161, 175, 189, 162, 176, 190, 163, 177, 191, 164, + 178, 192, 165, 179, 193, 166, 180, 194, 167, 181, 195, 168, 182, 196, 169, + 183, 197, 198, 216, 234, 199, 217, 235, 200, 218, 236, 201, 219, 237, 202, + 220, 238, 203, 221, 239, 204, 222, 240, 205, 223, 241, 206, 224, 242, 207, + 225, 243, 208, 226, 244, 209, 227, 245, 210, 228, 246, 211, 229, 247, 212, + 230, 248, 213, 231, 249, 214, 232, 250, 215, 233, 251, 252, 274, 296, 253, + 275, 297, 254, 276, 298, 255, 277, 299, 256, 278, 300, 257, 279, 301, 258, + 280, 302, 259, 281, 303, 260, 282, 304, 261, 283, 305, 262, 284, 306, 263, + 285, 307, 264, 286, 308, 265, 287, 309, 266, 288, 310, 267, 289, 311, 268, + 290, 312, 269, 291, 313, 270, 292, 314, 271, 293, 315, 272, 294, 316, 273, + 295, 317, 318, 348, 378, 319, 349, 379, 320, 350, 380, 321, 351, 381, 322, + 352, 382, 323, 353, 383, 324, 354, 384, 325, 355, 385, 326, 356, 386, 327, + 357, 387, 328, 358, 388, 329, 359, 389, 330, 360, 390, 331, 361, 391, 332, + 362, 392, 333, 363, 393, 334, 364, 394, 335, 365, 395, 336, 366, 396, 337, + 367, 397, 338, 368, 398, 339, 369, 399, 340, 370, 400, 341, 371, 401, 342, + 372, 402, 343, 373, 403, 344, 374, 404, 345, 375, 405, 346, 376, 406, 347, + 377, 407, 408, 464, 520, 409, 465, 521, 410, 466, 522, 411, 467, 523, 412, + 468, 524, 413, 469, 525, 414, 470, 526, 415, 471, 527, 416, 472, 528, 417, + 473, 529, 418, 474, 530, 419, 475, 531, 420, 476, 532, 421, 477, 533, 422, + 478, 534, 423, 479, 535, 424, 480, 536, 425, 481, 537, 426, 482, 538, 427, + 483, 539, 428, 484, 540, 429, 485, 541, 430, 486, 542, 431, 487, 543, 432, + 488, 544, 433, 489, 545, 434, 490, 546, 435, 491, 547, 436, 492, 548, 437, + 493, 549, 438, 494, 550, 439, 495, 551, 440, 496, 552, 441, 497, 553, 442, + 498, 554, 443, 499, 555, 444, 500, 556, 445, 501, 557, 446, 502, 558, 447, + 503, 559, 448, 504, 560, 449, 505, 561, 450, 506, 562, 451, 507, 563, 452, + 508, 564, 453, 509, 565, 454, 510, 566, 455, 511, 567, 456, 512, 568, 457, + 513, 569, 458, 514, 570, 459, 515, 571, 460, 516, 572, 461, 517, 573, 462, + 518, 574, 463, 519, 575] + +tab2 :: [Int] +tab2 = [0, 4, 8, 1, 5, 9, 2, 6, 10, 3, 7, 11, 12, 16, 20, 13, + 17, 21, 14, 18, 22, 15, 19, 23, 24, 28, 32, 25, 29, 33, 26, + 30, 34, 27, 31, 35, 36, 40, 44, 37, 41, 45, 38, 42, 46, 39, + 43, 47, 48, 54, 60, 49, 55, 61, 50, 56, 62, 51, 57, 63, 52, + 58, 64, 53, 59, 65, 66, 72, 78, 67, 73, 79, 68, 74, 80, 69, + 75, 81, 70, 76, 82, 71, 77, 83, 84, 94, 104, 85, 95, 105, 86, + 96, 106, 87, 97, 107, 88, 98, 108, 89, 99, 109, 90, 100, 110, 91, + 101, 111, 92, 102, 112, 93, 103, 113, 114, 126, 138, 115, 127, 139, 116, + 128, 140, 117, 129, 141, 118, 130, 142, 119, 131, 143, 120, 132, 144, 121, + 133, 145, 122, 134, 146, 123, 135, 147, 124, 136, 148, 125, 137, 149, 150, + 164, 178, 151, 165, 179, 152, 166, 180, 153, 167, 181, 154, 168, 182, 155, + 169, 183, 156, 170, 184, 157, 171, 185, 158, 172, 186, 159, 173, 187, 160, + 174, 188, 161, 175, 189, 162, 176, 190, 163, 177, 191, 192, 208, 224, 193, + 209, 225, 194, 210, 226, 195, 211, 227, 196, 212, 228, 197, 213, 229, 198, + 214, 230, 199, 215, 231, 200, 216, 232, 201, 217, 233, 202, 218, 234, 203, + 219, 235, 204, 220, 236, 205, 221, 237, 206, 222, 238, 207, 223, 239, 240, + 260, 280, 241, 261, 281, 242, 262, 282, 243, 263, 283, 244, 264, 284, 245, + 265, 285, 246, 266, 286, 247, 267, 287, 248, 268, 288, 249, 269, 289, 250, + 270, 290, 251, 271, 291, 252, 272, 292, 253, 273, 293, 254, 274, 294, 255, + 275, 295, 256, 276, 296, 257, 277, 297, 258, 278, 298, 259, 279, 299, 300, + 326, 352, 301, 327, 353, 302, 328, 354, 303, 329, 355, 304, 330, 356, 305, + 331, 357, 306, 332, 358, 307, 333, 359, 308, 334, 360, 309, 335, 361, 310, + 336, 362, 311, 337, 363, 312, 338, 364, 313, 339, 365, 314, 340, 366, 315, + 341, 367, 316, 342, 368, 317, 343, 369, 318, 344, 370, 319, 345, 371, 320, + 346, 372, 321, 347, 373, 322, 348, 374, 323, 349, 375, 324, 350, 376, 325, + 351, 377, 378, 444, 510, 379, 445, 511, 380, 446, 512, 381, 447, 513, 382, + 448, 514, 383, 449, 515, 384, 450, 516, 385, 451, 517, 386, 452, 518, 387, + 453, 519, 388, 454, 520, 389, 455, 521, 390, 456, 522, 391, 457, 523, 392, + 458, 524, 393, 459, 525, 394, 460, 526, 395, 461, 527, 396, 462, 528, 397, + 463, 529, 398, 464, 530, 399, 465, 531, 400, 466, 532, 401, 467, 533, 402, + 468, 534, 403, 469, 535, 404, 470, 536, 405, 471, 537, 406, 472, 538, 407, + 473, 539, 408, 474, 540, 409, 475, 541, 410, 476, 542, 411, 477, 543, 412, + 478, 544, 413, 479, 545, 414, 480, 546, 415, 481, 547, 416, 482, 548, 417, + 483, 549, 418, 484, 550, 419, 485, 551, 420, 486, 552, 421, 487, 553, 422, + 488, 554, 423, 489, 555, 424, 490, 556, 425, 491, 557, 426, 492, 558, 427, + 493, 559, 428, 494, 560, 429, 495, 561, 430, 496, 562, 431, 497, 563, 432, + 498, 564, 433, 499, 565, 434, 500, 566, 435, 501, 567, 436, 502, 568, 437, + 503, 569, 438, 504, 570, 439, 505, 571, 440, 506, 572, 441, 507, 573, 442, + 508, 574, 443, 509, 575] + +tab3 :: [Int] +tab3 = [0, 4, 8, 1, 5, 9, 2, 6, 10, 3, 7, 11, 12, 16, 20, 13, + 17, 21, 14, 18, 22, 15, 19, 23, 24, 28, 32, 25, 29, 33, 26, + 30, 34, 27, 31, 35, 36, 40, 44, 37, 41, 45, 38, 42, 46, 39, + 43, 47, 48, 54, 60, 49, 55, 61, 50, 56, 62, 51, 57, 63, 52, + 58, 64, 53, 59, 65, 66, 74, 82, 67, 75, 83, 68, 76, 84, 69, + 77, 85, 70, 78, 86, 71, 79, 87, 72, 80, 88, 73, 81, 89, 90, + 102, 114, 91, 103, 115, 92, 104, 116, 93, 105, 117, 94, 106, 118, 95, + 107, 119, 96, 108, 120, 97, 109, 121, 98, 110, 122, 99, 111, 123, 100, + 112, 124, 101, 113, 125, 126, 142, 158, 127, 143, 159, 128, 144, 160, 129, + 145, 161, 130, 146, 162, 131, 147, 163, 132, 148, 164, 133, 149, 165, 134, + 150, 166, 135, 151, 167, 136, 152, 168, 137, 153, 169, 138, 154, 170, 139, + 155, 171, 140, 156, 172, 141, 157, 173, 174, 194, 214, 175, 195, 215, 176, + 196, 216, 177, 197, 217, 178, 198, 218, 179, 199, 219, 180, 200, 220, 181, + 201, 221, 182, 202, 222, 183, 203, 223, 184, 204, 224, 185, 205, 225, 186, + 206, 226, 187, 207, 227, 188, 208, 228, 189, 209, 229, 190, 210, 230, 191, + 211, 231, 192, 212, 232, 193, 213, 233, 234, 260, 286, 235, 261, 287, 236, + 262, 288, 237, 263, 289, 238, 264, 290, 239, 265, 291, 240, 266, 292, 241, + 267, 293, 242, 268, 294, 243, 269, 295, 244, 270, 296, 245, 271, 297, 246, + 272, 298, 247, 273, 299, 248, 274, 300, 249, 275, 301, 250, 276, 302, 251, + 277, 303, 252, 278, 304, 253, 279, 305, 254, 280, 306, 255, 281, 307, 256, + 282, 308, 257, 283, 309, 258, 284, 310, 259, 285, 311, 312, 346, 380, 313, + 347, 381, 314, 348, 382, 315, 349, 383, 316, 350, 384, 317, 351, 385, 318, + 352, 386, 319, 353, 387, 320, 354, 388, 321, 355, 389, 322, 356, 390, 323, + 357, 391, 324, 358, 392, 325, 359, 393, 326, 360, 394, 327, 361, 395, 328, + 362, 396, 329, 363, 397, 330, 364, 398, 331, 365, 399, 332, 366, 400, 333, + 367, 401, 334, 368, 402, 335, 369, 403, 336, 370, 404, 337, 371, 405, 338, + 372, 406, 339, 373, 407, 340, 374, 408, 341, 375, 409, 342, 376, 410, 343, + 377, 411, 344, 378, 412, 345, 379, 413, 414, 456, 498, 415, 457, 499, 416, + 458, 500, 417, 459, 501, 418, 460, 502, 419, 461, 503, 420, 462, 504, 421, + 463, 505, 422, 464, 506, 423, 465, 507, 424, 466, 508, 425, 467, 509, 426, + 468, 510, 427, 469, 511, 428, 470, 512, 429, 471, 513, 430, 472, 514, 431, + 473, 515, 432, 474, 516, 433, 475, 517, 434, 476, 518, 435, 477, 519, 436, + 478, 520, 437, 479, 521, 438, 480, 522, 439, 481, 523, 440, 482, 524, 441, + 483, 525, 442, 484, 526, 443, 485, 527, 444, 486, 528, 445, 487, 529, 446, + 488, 530, 447, 489, 531, 448, 490, 532, 449, 491, 533, 450, 492, 534, 451, + 493, 535, 452, 494, 536, 453, 495, 537, 454, 496, 538, 455, 497, 539, 540, + 552, 564, 541, 553, 565, 542, 554, 566, 543, 555, 567, 544, 556, 568, 545, + 557, 569, 546, 558, 570, 547, 559, 571, 548, 560, 572, 549, 561, 573, 550, + 562, 574, 551, 563, 575] + + +-- +-- tableHuffmanQuad, tableHuffman +-- +-- The Huffman tables and table pairs. +-- +tableHuffmanQuad :: [[([Int], (Int, Int, Int, Int))]] +tableHuffmanQuad = [tableHuffRqa, -- 0 + tableHuffRqb] -- 1 + +tableHuffman :: [([([Int], (Int, Int))], Int)] +tableHuffman = [error "Huffman Table 0 does not exist.", + (tableHuffR00, 0), -- 1 + (tableHuffR01, 0), -- 2 + (tableHuffR02, 0), -- 3 + error "Huffman Table 4 does not exist.", + (tableHuffR03, 0), -- 5 + (tableHuffR04, 0), -- 6 + (tableHuffR05, 0), -- 7 + (tableHuffR06, 0), -- 8 + (tableHuffR07, 0), -- 9 + (tableHuffR08, 0), -- 10 + (tableHuffR09, 0), -- 11 + (tableHuffR10, 0), -- 12 + (tableHuffR11, 0), -- 13 + error "Huffman Table 14 does not exist.", + (tableHuffR12, 0), -- 15 + (tableHuffR13, 1), -- 16 + (tableHuffR13, 2), -- 17 + (tableHuffR13, 3), -- 18 + (tableHuffR13, 4), -- 19 + (tableHuffR13, 6), -- 20 + (tableHuffR13, 8), -- 21 + (tableHuffR13, 10), -- 22 + (tableHuffR13, 13), -- 23 + (tableHuffR14, 4), -- 24 + (tableHuffR14, 5), -- 25 + (tableHuffR14, 6), -- 26 + (tableHuffR14, 7), -- 27 + (tableHuffR14, 8), -- 28 + (tableHuffR14, 9), -- 29 + (tableHuffR14, 11), -- 30 + (tableHuffR14, 13)] -- 31 + + +-- Not exported: +tableHuffRqa :: [([Int], (Int, Int, Int, Int))] +tableHuffRqa = [([1],(0,0,0,0)), + ([0,1,0,1],(0,0,0,1)), + ([0,1,0,0],(0,0,1,0)), + ([0,0,1,0,1],(0,0,1,1)), + ([0,1,1,0],(0,1,0,0)), + ([0,0,0,1,0,1],(0,1,0,1)), + ([0,0,1,0,0],(0,1,1,0)), + ([0,0,0,1,0,0],(0,1,1,1)), + ([0,1,1,1],(1,0,0,0)), + ([0,0,0,1,1],(1,0,0,1)), + ([0,0,1,1,0],(1,0,1,0)), + ([0,0,0,0,0,0],(1,0,1,1)), + ([0,0,1,1,1],(1,1,0,0)), + ([0,0,0,0,1,0],(1,1,0,1)), + ([0,0,0,0,1,1],(1,1,1,0)), + ([0,0,0,0,0,1],(1,1,1,1))] + +tableHuffRqb :: [([Int], (Int, Int, Int, Int))] +tableHuffRqb = [([1,1,1,1],(0,0,0,0)), + ([1,1,1,0],(0,0,0,1)), + ([1,1,0,1],(0,0,1,0)), + ([1,1,0,0],(0,0,1,1)), + ([1,0,1,1],(0,1,0,0)), + ([1,0,1,0],(0,1,0,1)), + ([1,0,0,1],(0,1,1,0)), + ([1,0,0,0],(0,1,1,1)), + ([0,1,1,1],(1,0,0,0)), + ([0,1,1,0],(1,0,0,1)), + ([0,1,0,1],(1,0,1,0)), + ([0,1,0,0],(1,0,1,1)), + ([0,0,1,1],(1,1,0,0)), + ([0,0,1,0],(1,1,0,1)), + ([0,0,0,1],(1,1,1,0)), + ([0,0,0,0],(1,1,1,1))] + +tableHuffR00 :: [([Int], (Int, Int))] +tableHuffR00 = [([1],(0,0)), + ([0,0,1],(0,1)), + ([0,1],(1,0)), + ([0,0,0],(1,1))] + +tableHuffR01 :: [([Int], (Int, Int))] +tableHuffR01 = [([1],(0,0)), + ([0,1,0],(0,1)), + ([0,0,0,0,0,1],(0,2)), + ([0,1,1],(1,0)), + ([0,0,1],(1,1)), + ([0,0,0,0,1],(1,2)), + ([0,0,0,1,1],(2,0)), + ([0,0,0,1,0],(2,1)), + ([0,0,0,0,0,0],(2,2))] + +tableHuffR02 :: [([Int], (Int, Int))] +tableHuffR02 = [([1,1],(0,0)), + ([1,0],(0,1)), + ([0,0,0,0,0,1],(0,2)), + ([0,0,1],(1,0)), + ([0,1],(1,1)), + ([0,0,0,0,1],(1,2)), + ([0,0,0,1,1],(2,0)), + ([0,0,0,1,0],(2,1)), + ([0,0,0,0,0,0],(2,2))] + +tableHuffR03 :: [([Int], (Int, Int))] +tableHuffR03 = [([1],(0,0)), + ([0,1,0],(0,1)), + ([0,0,0,1,1,0],(0,2)), + ([0,0,0,0,1,0,1],(0,3)), + ([0,1,1],(1,0)), + ([0,0,1],(1,1)), + ([0,0,0,1,0,0],(1,2)), + ([0,0,0,0,1,0,0],(1,3)), + ([0,0,0,1,1,1],(2,0)), + ([0,0,0,1,0,1],(2,1)), + ([0,0,0,0,1,1,1],(2,2)), + ([0,0,0,0,0,0,0,1],(2,3)), + ([0,0,0,0,1,1,0],(3,0)), + ([0,0,0,0,0,1],(3,1)), + ([0,0,0,0,0,0,1],(3,2)), + ([0,0,0,0,0,0,0,0],(3,3))] + +tableHuffR04 :: [([Int], (Int, Int))] +tableHuffR04 = [([1,1,1],(0,0)), + ([0,1,1],(0,1)), + ([0,0,1,0,1],(0,2)), + ([0,0,0,0,0,0,1],(0,3)), + ([1,1,0],(1,0)), + ([1,0],(1,1)), + ([0,0,1,1],(1,2)), + ([0,0,0,1,0],(1,3)), + ([0,1,0,1],(2,0)), + ([0,1,0,0],(2,1)), + ([0,0,1,0,0],(2,2)), + ([0,0,0,0,0,1],(2,3)), + ([0,0,0,0,1,1],(3,0)), + ([0,0,0,1,1],(3,1)), + ([0,0,0,0,1,0],(3,2)), + ([0,0,0,0,0,0,0],(3,3))] + +tableHuffR05 :: [([Int], (Int, Int))] +tableHuffR05 = [([1],(0,0)), + ([0,1,0],(0,1)), + ([0,0,1,0,1,0],(0,2)), + ([0,0,0,1,0,0,1,1],(0,3)), + ([0,0,0,1,0,0,0,0],(0,4)), + ([0,0,0,0,0,1,0,1,0],(0,5)), + ([0,1,1],(1,0)), + ([0,0,1,1],(1,1)), + ([0,0,0,1,1,1],(1,2)), + ([0,0,0,1,0,1,0],(1,3)), + ([0,0,0,0,1,0,1],(1,4)), + ([0,0,0,0,0,0,1,1],(1,5)), + ([0,0,1,0,1,1],(2,0)), + ([0,0,1,0,0],(2,1)), + ([0,0,0,1,1,0,1],(2,2)), + ([0,0,0,1,0,0,0,1],(2,3)), + ([0,0,0,0,1,0,0,0],(2,4)), + ([0,0,0,0,0,0,1,0,0],(2,5)), + ([0,0,0,1,1,0,0],(3,0)), + ([0,0,0,1,0,1,1],(3,1)), + ([0,0,0,1,0,0,1,0],(3,2)), + ([0,0,0,0,0,1,1,1,1],(3,3)), + ([0,0,0,0,0,1,0,1,1],(3,4)), + ([0,0,0,0,0,0,0,1,0],(3,5)), + ([0,0,0,0,1,1,1],(4,0)), + ([0,0,0,0,1,1,0],(4,1)), + ([0,0,0,0,1,0,0,1],(4,2)), + ([0,0,0,0,0,1,1,1,0],(4,3)), + ([0,0,0,0,0,0,0,1,1],(4,4)), + ([0,0,0,0,0,0,0,0,0,1],(4,5)), + ([0,0,0,0,0,1,1,0],(5,0)), + ([0,0,0,0,0,1,0,0],(5,1)), + ([0,0,0,0,0,0,1,0,1],(5,2)), + ([0,0,0,0,0,0,0,0,1,1],(5,3)), + ([0,0,0,0,0,0,0,0,1,0],(5,4)), + ([0,0,0,0,0,0,0,0,0,0],(5,5))] + +tableHuffR06 :: [([Int], (Int, Int))] +tableHuffR06 = [([1,1],(0,0)), + ([1,0,0],(0,1)), + ([0,0,0,1,1,0],(0,2)), + ([0,0,0,1,0,0,1,0],(0,3)), + ([0,0,0,0,1,1,0,0],(0,4)), + ([0,0,0,0,0,0,1,0,1],(0,5)), + ([1,0,1],(1,0)), + ([0,1],(1,1)), + ([0,0,1,0],(1,2)), + ([0,0,0,1,0,0,0,0],(1,3)), + ([0,0,0,0,1,0,0,1],(1,4)), + ([0,0,0,0,0,0,1,1],(1,5)), + ([0,0,0,1,1,1],(2,0)), + ([0,0,1,1],(2,1)), + ([0,0,0,1,0,1],(2,2)), + ([0,0,0,0,1,1,1,0],(2,3)), + ([0,0,0,0,0,1,1,1],(2,4)), + ([0,0,0,0,0,0,0,1,1],(2,5)), + ([0,0,0,1,0,0,1,1],(3,0)), + ([0,0,0,1,0,0,0,1],(3,1)), + ([0,0,0,0,1,1,1,1],(3,2)), + ([0,0,0,0,0,1,1,0,1],(3,3)), + ([0,0,0,0,0,1,0,1,0],(3,4)), + ([0,0,0,0,0,0,0,1,0,0],(3,5)), + ([0,0,0,0,1,1,0,1],(4,0)), + ([0,0,0,0,1,0,1],(4,1)), + ([0,0,0,0,1,0,0,0],(4,2)), + ([0,0,0,0,0,1,0,1,1],(4,3)), + ([0,0,0,0,0,0,0,1,0,1],(4,4)), + ([0,0,0,0,0,0,0,0,0,1],(4,5)), + ([0,0,0,0,0,1,1,0,0],(5,0)), + ([0,0,0,0,0,1,0,0],(5,1)), + ([0,0,0,0,0,0,1,0,0],(5,2)), + ([0,0,0,0,0,0,0,0,1],(5,3)), + ([0,0,0,0,0,0,0,0,0,0,1],(5,4)), + ([0,0,0,0,0,0,0,0,0,0,0],(5,5))] + +tableHuffR07 :: [([Int], (Int, Int))] +tableHuffR07 = [([1,1,1],(0,0)), + ([1,0,1],(0,1)), + ([0,1,0,0,1],(0,2)), + ([0,0,1,1,1,0],(0,3)), + ([0,0,0,0,1,1,1,1],(0,4)), + ([0,0,0,0,0,0,1,1,1],(0,5)), + ([1,1,0],(1,0)), + ([1,0,0],(1,1)), + ([0,1,0,1],(1,2)), + ([0,0,1,0,1],(1,3)), + ([0,0,0,1,1,0],(1,4)), + ([0,0,0,0,0,1,1,1],(1,5)), + ([0,1,1,1],(2,0)), + ([0,1,1,0],(2,1)), + ([0,1,0,0,0],(2,2)), + ([0,0,1,0,0,0],(2,3)), + ([0,0,0,1,0,0,0],(2,4)), + ([0,0,0,0,0,1,0,1],(2,5)), + ([0,0,1,1,1,1],(3,0)), + ([0,0,1,1,0],(3,1)), + ([0,0,1,0,0,1],(3,2)), + ([0,0,0,1,0,1,0],(3,3)), + ([0,0,0,0,1,0,1],(3,4)), + ([0,0,0,0,0,0,0,1],(3,5)), + ([0,0,0,1,0,1,1],(4,0)), + ([0,0,0,1,1,1],(4,1)), + ([0,0,0,1,0,0,1],(4,2)), + ([0,0,0,0,1,1,0],(4,3)), + ([0,0,0,0,0,1,0,0],(4,4)), + ([0,0,0,0,0,0,0,0,1],(4,5)), + ([0,0,0,0,1,1,1,0],(5,0)), + ([0,0,0,0,1,0,0],(5,1)), + ([0,0,0,0,0,1,1,0],(5,2)), + ([0,0,0,0,0,0,1,0],(5,3)), + ([0,0,0,0,0,0,1,1,0],(5,4)), + ([0,0,0,0,0,0,0,0,0],(5,5))] + +tableHuffR08 :: [([Int], (Int, Int))] +tableHuffR08 = [([1],(0,0)), + ([0,1,0],(0,1)), + ([0,0,1,0,1,0],(0,2)), + ([0,0,0,1,0,1,1,1],(0,3)), + ([0,0,0,1,0,0,0,1,1],(0,4)), + ([0,0,0,0,1,1,1,1,0],(0,5)), + ([0,0,0,0,0,1,1,0,0],(0,6)), + ([0,0,0,0,0,1,0,0,0,1],(0,7)), + ([0,1,1],(1,0)), + ([0,0,1,1],(1,1)), + ([0,0,1,0,0,0],(1,2)), + ([0,0,0,1,1,0,0],(1,3)), + ([0,0,0,1,0,0,1,0],(1,4)), + ([0,0,0,0,1,0,1,0,1],(1,5)), + ([0,0,0,0,1,1,0,0],(1,6)), + ([0,0,0,0,0,1,1,1],(1,7)), + ([0,0,1,0,1,1],(2,0)), + ([0,0,1,0,0,1],(2,1)), + ([0,0,0,1,1,1,1],(2,2)), + ([0,0,0,1,0,1,0,1],(2,3)), + ([0,0,0,1,0,0,0,0,0],(2,4)), + ([0,0,0,0,1,0,1,0,0,0],(2,5)), + ([0,0,0,0,1,0,0,1,1],(2,6)), + ([0,0,0,0,0,0,1,1,0],(2,7)), + ([0,0,0,1,1,1,0],(3,0)), + ([0,0,0,1,1,0,1],(3,1)), + ([0,0,0,1,0,1,1,0],(3,2)), + ([0,0,0,1,0,0,0,1,0],(3,3)), + ([0,0,0,0,1,0,1,1,1,0],(3,4)), + ([0,0,0,0,0,1,0,1,1,1],(3,5)), + ([0,0,0,0,1,0,0,1,0],(3,6)), + ([0,0,0,0,0,0,0,1,1,1],(3,7)), + ([0,0,0,1,0,1,0,0],(4,0)), + ([0,0,0,1,0,0,1,1],(4,1)), + ([0,0,0,1,0,0,0,0,1],(4,2)), + ([0,0,0,0,1,0,1,1,1,1],(4,3)), + ([0,0,0,0,0,1,1,0,1,1],(4,4)), + ([0,0,0,0,0,1,0,1,1,0],(4,5)), + ([0,0,0,0,0,0,1,0,0,1],(4,6)), + ([0,0,0,0,0,0,0,0,1,1],(4,7)), + ([0,0,0,0,1,1,1,1,1],(5,0)), + ([0,0,0,0,1,0,1,1,0],(5,1)), + ([0,0,0,0,1,0,1,0,0,1],(5,2)), + ([0,0,0,0,0,1,1,0,1,0],(5,3)), + ([0,0,0,0,0,0,1,0,1,0,1],(5,4)), + ([0,0,0,0,0,0,1,0,1,0,0],(5,5)), + ([0,0,0,0,0,0,0,1,0,1],(5,6)), + ([0,0,0,0,0,0,0,0,0,1,1],(5,7)), + ([0,0,0,0,1,1,1,0],(6,0)), + ([0,0,0,0,1,1,0,1],(6,1)), + ([0,0,0,0,0,1,0,1,0],(6,2)), + ([0,0,0,0,0,0,1,0,1,1],(6,3)), + ([0,0,0,0,0,1,0,0,0,0],(6,4)), + ([0,0,0,0,0,0,0,1,1,0],(6,5)), + ([0,0,0,0,0,0,0,0,1,0,1],(6,6)), + ([0,0,0,0,0,0,0,0,0,0,1],(6,7)), + ([0,0,0,0,0,1,0,0,1],(7,0)), + ([0,0,0,0,1,0,0,0],(7,1)), + ([0,0,0,0,0,0,1,1,1],(7,2)), + ([0,0,0,0,0,0,1,0,0,0],(7,3)), + ([0,0,0,0,0,0,0,1,0,0],(7,4)), + ([0,0,0,0,0,0,0,0,1,0,0],(7,5)), + ([0,0,0,0,0,0,0,0,0,1,0],(7,6)), + ([0,0,0,0,0,0,0,0,0,0,0],(7,7))] + +tableHuffR09 :: [([Int], (Int, Int))] +tableHuffR09 = [([1,1],(0,0)), + ([1,0,0],(0,1)), + ([0,1,0,1,0],(0,2)), + ([0,0,1,1,0,0,0],(0,3)), + ([0,0,1,0,0,0,1,0],(0,4)), + ([0,0,0,1,0,0,0,0,1],(0,5)), + ([0,0,0,1,0,1,0,1],(0,6)), + ([0,0,0,0,0,1,1,1,1],(0,7)), + ([1,0,1],(1,0)), + ([0,1,1],(1,1)), + ([0,1,0,0],(1,2)), + ([0,0,1,0,1,0],(1,3)), + ([0,0,1,0,0,0,0,0],(1,4)), + ([0,0,0,1,0,0,0,1],(1,5)), + ([0,0,0,1,0,1,1],(1,6)), + ([0,0,0,0,1,0,1,0],(1,7)), + ([0,1,0,1,1],(2,0)), + ([0,0,1,1,1],(2,1)), + ([0,0,1,1,0,1],(2,2)), + ([0,0,1,0,0,1,0],(2,3)), + ([0,0,0,1,1,1,1,0],(2,4)), + ([0,0,0,0,1,1,1,1,1],(2,5)), + ([0,0,0,1,0,1,0,0],(2,6)), + ([0,0,0,0,0,1,0,1],(2,7)), + ([0,0,1,1,0,0,1],(3,0)), + ([0,0,1,0,1,1],(3,1)), + ([0,0,1,0,0,1,1],(3,2)), + ([0,0,0,1,1,1,0,1,1],(3,3)), + ([0,0,0,1,1,0,1,1],(3,4)), + ([0,0,0,0,0,1,0,0,1,0],(3,5)), + ([0,0,0,0,1,1,0,0],(3,6)), + ([0,0,0,0,0,0,1,0,1],(3,7)), + ([0,0,1,0,0,0,1,1],(4,0)), + ([0,0,1,0,0,0,0,1],(4,1)), + ([0,0,0,1,1,1,1,1],(4,2)), + ([0,0,0,1,1,1,0,1,0],(4,3)), + ([0,0,0,0,1,1,1,1,0],(4,4)), + ([0,0,0,0,0,1,0,0,0,0],(4,5)), + ([0,0,0,0,0,0,1,1,1],(4,6)), + ([0,0,0,0,0,0,0,1,0,1],(4,7)), + ([0,0,0,1,1,1,0,0],(5,0)), + ([0,0,0,1,1,0,1,0],(5,1)), + ([0,0,0,1,0,0,0,0,0],(5,2)), + ([0,0,0,0,0,1,0,0,1,1],(5,3)), + ([0,0,0,0,0,1,0,0,0,1],(5,4)), + ([0,0,0,0,0,0,0,1,1,1,1],(5,5)), + ([0,0,0,0,0,0,1,0,0,0],(5,6)), + ([0,0,0,0,0,0,0,1,1,1,0],(5,7)), + ([0,0,0,0,1,1,1,0],(6,0)), + ([0,0,0,1,1,0,0],(6,1)), + ([0,0,0,1,0,0,1],(6,2)), + ([0,0,0,0,1,1,0,1],(6,3)), + ([0,0,0,0,0,1,1,1,0],(6,4)), + ([0,0,0,0,0,0,1,0,0,1],(6,5)), + ([0,0,0,0,0,0,0,1,0,0],(6,6)), + ([0,0,0,0,0,0,0,0,0,1],(6,7)), + ([0,0,0,0,1,0,1,1],(7,0)), + ([0,0,0,0,1,0,0],(7,1)), + ([0,0,0,0,0,1,1,0],(7,2)), + ([0,0,0,0,0,0,1,1,0],(7,3)), + ([0,0,0,0,0,0,0,1,1,0],(7,4)), + ([0,0,0,0,0,0,0,0,1,1],(7,5)), + ([0,0,0,0,0,0,0,0,1,0],(7,6)), + ([0,0,0,0,0,0,0,0,0,0],(7,7))] + +tableHuffR10 :: [([Int], (Int, Int))] +tableHuffR10 = [([1,0,0,1],(0,0)), + ([1,1,0],(0,1)), + ([1,0,0,0,0],(0,2)), + ([0,1,0,0,0,0,1],(0,3)), + ([0,0,1,0,1,0,0,1],(0,4)), + ([0,0,0,1,0,0,1,1,1],(0,5)), + ([0,0,0,1,0,0,1,1,0],(0,6)), + ([0,0,0,0,1,1,0,1,0],(0,7)), + ([1,1,1],(1,0)), + ([1,0,1],(1,1)), + ([0,1,1,0],(1,2)), + ([0,1,0,0,1],(1,3)), + ([0,0,1,0,1,1,1],(1,4)), + ([0,0,1,0,0,0,0],(1,5)), + ([0,0,0,1,1,0,1,0],(1,6)), + ([0,0,0,0,1,0,1,1],(1,7)), + ([1,0,0,0,1],(2,0)), + ([0,1,1,1],(2,1)), + ([0,1,0,1,1],(2,2)), + ([0,0,1,1,1,0],(2,3)), + ([0,0,1,0,1,0,1],(2,4)), + ([0,0,0,1,1,1,1,0],(2,5)), + ([0,0,0,1,0,1,0],(2,6)), + ([0,0,0,0,0,1,1,1],(2,7)), + ([0,1,0,0,0,1],(3,0)), + ([0,1,0,1,0],(3,1)), + ([0,0,1,1,1,1],(3,2)), + ([0,0,1,1,0,0],(3,3)), + ([0,0,1,0,0,1,0],(3,4)), + ([0,0,0,1,1,1,0,0],(3,5)), + ([0,0,0,0,1,1,1,0],(3,6)), + ([0,0,0,0,0,1,0,1],(3,7)), + ([0,1,0,0,0,0,0],(4,0)), + ([0,0,1,1,0,1],(4,1)), + ([0,0,1,0,1,1,0],(4,2)), + ([0,0,1,0,0,1,1],(4,3)), + ([0,0,0,1,0,0,1,0],(4,4)), + ([0,0,0,1,0,0,0,0],(4,5)), + ([0,0,0,0,1,0,0,1],(4,6)), + ([0,0,0,0,0,0,1,0,1],(4,7)), + ([0,0,1,0,1,0,0,0],(5,0)), + ([0,0,1,0,0,0,1],(5,1)), + ([0,0,0,1,1,1,1,1],(5,2)), + ([0,0,0,1,1,1,0,1],(5,3)), + ([0,0,0,1,0,0,0,1],(5,4)), + ([0,0,0,0,0,1,1,0,1],(5,5)), + ([0,0,0,0,0,1,0,0],(5,6)), + ([0,0,0,0,0,0,0,1,0],(5,7)), + ([0,0,0,1,1,0,1,1],(6,0)), + ([0,0,0,1,1,0,0],(6,1)), + ([0,0,0,1,0,1,1],(6,2)), + ([0,0,0,0,1,1,1,1],(6,3)), + ([0,0,0,0,1,0,1,0],(6,4)), + ([0,0,0,0,0,0,1,1,1],(6,5)), + ([0,0,0,0,0,0,1,0,0],(6,6)), + ([0,0,0,0,0,0,0,0,0,1],(6,7)), + ([0,0,0,0,1,1,0,1,1],(7,0)), + ([0,0,0,0,1,1,0,0],(7,1)), + ([0,0,0,0,1,0,0,0],(7,2)), + ([0,0,0,0,0,1,1,0,0],(7,3)), + ([0,0,0,0,0,0,1,1,0],(7,4)), + ([0,0,0,0,0,0,0,1,1],(7,5)), + ([0,0,0,0,0,0,0,0,1],(7,6)), + ([0,0,0,0,0,0,0,0,0,0],(7,7))] + +tableHuffR11 :: [([Int], (Int, Int))] +tableHuffR11 = [([1],(0,0)), + ([0,1,0,1],(0,1)), + ([0,0,1,1,1,0],(0,2)), + ([0,0,1,0,1,0,1],(0,3)), + ([0,0,1,0,0,0,1,0],(0,4)), + ([0,0,0,1,1,0,0,1,1],(0,5)), + ([0,0,0,1,0,1,1,1,0],(0,6)), + ([0,0,0,1,0,0,0,1,1,1],(0,7)), + ([0,0,0,1,0,1,0,1,0],(0,8)), + ([0,0,0,0,1,1,0,1,0,0],(0,9)), + ([0,0,0,0,1,0,0,0,1,0,0],(0,10)), + ([0,0,0,0,0,1,1,0,1,0,0],(0,11)), + ([0,0,0,0,0,1,0,0,0,0,1,1],(0,12)), + ([0,0,0,0,0,0,1,0,1,1,0,0],(0,13)), + ([0,0,0,0,0,0,0,1,0,1,0,1,1],(0,14)), + ([0,0,0,0,0,0,0,0,1,0,0,1,1],(0,15)), + ([0,1,1],(1,0)), + ([0,1,0,0],(1,1)), + ([0,0,1,1,0,0],(1,2)), + ([0,0,1,0,0,1,1],(1,3)), + ([0,0,0,1,1,1,1,1],(1,4)), + ([0,0,0,1,1,0,1,0],(1,5)), + ([0,0,0,1,0,1,1,0,0],(1,6)), + ([0,0,0,1,0,0,0,0,1],(1,7)), + ([0,0,0,0,1,1,1,1,1],(1,8)), + ([0,0,0,0,1,1,0,0,0],(1,9)), + ([0,0,0,0,1,0,0,0,0,0],(1,10)), + ([0,0,0,0,0,1,1,0,0,0],(1,11)), + ([0,0,0,0,0,0,1,1,1,1,1],(1,12)), + ([0,0,0,0,0,0,1,0,0,0,1,1],(1,13)), + ([0,0,0,0,0,0,0,1,0,1,1,0],(1,14)), + ([0,0,0,0,0,0,0,0,1,1,1,0],(1,15)), + ([0,0,1,1,1,1],(2,0)), + ([0,0,1,1,0,1],(2,1)), + ([0,0,1,0,1,1,1],(2,2)), + ([0,0,1,0,0,1,0,0],(2,3)), + ([0,0,0,1,1,1,0,1,1],(2,4)), + ([0,0,0,1,1,0,0,0,1],(2,5)), + ([0,0,0,1,0,0,1,1,0,1],(2,6)), + ([0,0,0,1,0,0,0,0,0,1],(2,7)), + ([0,0,0,0,1,1,1,0,1],(2,8)), + ([0,0,0,0,1,0,1,0,0,0],(2,9)), + ([0,0,0,0,0,1,1,1,1,0],(2,10)), + ([0,0,0,0,0,1,0,1,0,0,0],(2,11)), + ([0,0,0,0,0,0,1,1,0,1,1],(2,12)), + ([0,0,0,0,0,0,1,0,0,0,0,1],(2,13)), + ([0,0,0,0,0,0,0,1,0,1,0,1,0],(2,14)), + ([0,0,0,0,0,0,0,0,1,0,0,0,0],(2,15)), + ([0,0,1,0,1,1,0],(3,0)), + ([0,0,1,0,1,0,0],(3,1)), + ([0,0,1,0,0,1,0,1],(3,2)), + ([0,0,0,1,1,1,1,0,1],(3,3)), + ([0,0,0,1,1,1,0,0,0],(3,4)), + ([0,0,0,1,0,0,1,1,1,1],(3,5)), + ([0,0,0,1,0,0,1,0,0,1],(3,6)), + ([0,0,0,1,0,0,0,0,0,0],(3,7)), + ([0,0,0,0,1,0,1,0,1,1],(3,8)), + ([0,0,0,0,1,0,0,1,1,0,0],(3,9)), + ([0,0,0,0,0,1,1,1,0,0,0],(3,10)), + ([0,0,0,0,0,1,0,0,1,0,1],(3,11)), + ([0,0,0,0,0,0,1,1,0,1,0],(3,12)), + ([0,0,0,0,0,0,0,1,1,1,1,1],(3,13)), + ([0,0,0,0,0,0,0,0,1,1,0,0,1],(3,14)), + ([0,0,0,0,0,0,0,0,0,1,1,1,0],(3,15)), + ([0,0,1,0,0,0,1,1],(4,0)), + ([0,0,1,0,0,0,0],(4,1)), + ([0,0,0,1,1,1,1,0,0],(4,2)), + ([0,0,0,1,1,1,0,0,1],(4,3)), + ([0,0,0,1,1,0,0,0,0,1],(4,4)), + ([0,0,0,1,0,0,1,0,1,1],(4,5)), + ([0,0,0,0,1,1,1,0,0,1,0],(4,6)), + ([0,0,0,0,1,0,1,1,0,1,1],(4,7)), + ([0,0,0,0,1,1,0,1,1,0],(4,8)), + ([0,0,0,0,1,0,0,1,0,0,1],(4,9)), + ([0,0,0,0,0,1,1,0,1,1,1],(4,10)), + ([0,0,0,0,0,0,1,0,1,0,0,1],(4,11)), + ([0,0,0,0,0,0,1,1,0,0,0,0],(4,12)), + ([0,0,0,0,0,0,0,1,1,0,1,0,1],(4,13)), + ([0,0,0,0,0,0,0,0,1,0,1,1,1],(4,14)), + ([0,0,0,0,0,0,0,0,0,1,1,0,0,0],(4,15)), + ([0,0,0,1,1,1,0,1,0],(5,0)), + ([0,0,0,1,1,0,1,1],(5,1)), + ([0,0,0,1,1,0,0,1,0],(5,2)), + ([0,0,0,1,1,0,0,0,0,0],(5,3)), + ([0,0,0,1,0,0,1,1,0,0],(5,4)), + ([0,0,0,1,0,0,0,1,1,0],(5,5)), + ([0,0,0,0,1,0,1,1,1,0,1],(5,6)), + ([0,0,0,0,1,0,1,0,1,0,0],(5,7)), + ([0,0,0,0,1,0,0,1,1,0,1],(5,8)), + ([0,0,0,0,0,1,1,1,0,1,0],(5,9)), + ([0,0,0,0,0,1,0,0,1,1,1,1],(5,10)), + ([0,0,0,0,0,0,1,1,1,0,1],(5,11)), + ([0,0,0,0,0,0,1,0,0,1,0,1,0],(5,12)), + ([0,0,0,0,0,0,0,1,1,0,0,0,1],(5,13)), + ([0,0,0,0,0,0,0,0,1,0,1,0,0,1],(5,14)), + ([0,0,0,0,0,0,0,0,0,1,0,0,0,1],(5,15)), + ([0,0,0,1,0,1,1,1,1],(6,0)), + ([0,0,0,1,0,1,1,0,1],(6,1)), + ([0,0,0,1,0,0,1,1,1,0],(6,2)), + ([0,0,0,1,0,0,1,0,1,0],(6,3)), + ([0,0,0,0,1,1,1,0,0,1,1],(6,4)), + ([0,0,0,0,1,0,1,1,1,1,0],(6,5)), + ([0,0,0,0,1,0,1,1,0,1,0],(6,6)), + ([0,0,0,0,1,0,0,1,1,1,1],(6,7)), + ([0,0,0,0,1,0,0,0,1,0,1],(6,8)), + ([0,0,0,0,0,1,0,1,0,0,1,1],(6,9)), + ([0,0,0,0,0,1,0,0,0,1,1,1],(6,10)), + ([0,0,0,0,0,0,1,1,0,0,1,0],(6,11)), + ([0,0,0,0,0,0,0,1,1,1,0,1,1],(6,12)), + ([0,0,0,0,0,0,0,1,0,0,1,1,0],(6,13)), + ([0,0,0,0,0,0,0,0,1,0,0,1,0,0],(6,14)), + ([0,0,0,0,0,0,0,0,0,0,1,1,1,1],(6,15)), + ([0,0,0,1,0,0,1,0,0,0],(7,0)), + ([0,0,0,1,0,0,0,1,0],(7,1)), + ([0,0,0,0,1,1,1,0,0,0],(7,2)), + ([0,0,0,0,1,0,1,1,1,1,1],(7,3)), + ([0,0,0,0,1,0,1,1,1,0,0],(7,4)), + ([0,0,0,0,1,0,1,0,1,0,1],(7,5)), + ([0,0,0,0,0,1,0,1,1,0,1,1],(7,6)), + ([0,0,0,0,0,1,0,1,1,0,1,0],(7,7)), + ([0,0,0,0,0,1,0,1,0,1,1,0],(7,8)), + ([0,0,0,0,0,1,0,0,1,0,0,1],(7,9)), + ([0,0,0,0,0,0,1,0,0,1,1,0,1],(7,10)), + ([0,0,0,0,0,0,1,0,0,0,0,0,1],(7,11)), + ([0,0,0,0,0,0,0,1,1,0,0,1,1],(7,12)), + ([0,0,0,0,0,0,0,0,1,0,1,1,0,0],(7,13)), + ([0,0,0,0,0,0,0,0,0,0,1,0,1,0,1,1],(7,14)), + ([0,0,0,0,0,0,0,0,0,0,1,0,1,0,1,0],(7,15)), + ([0,0,0,1,0,1,0,1,1],(8,0)), + ([0,0,0,1,0,1,0,0],(8,1)), + ([0,0,0,0,1,1,1,1,0],(8,2)), + ([0,0,0,0,1,0,1,1,0,0],(8,3)), + ([0,0,0,0,1,1,0,1,1,1],(8,4)), + ([0,0,0,0,1,0,0,1,1,1,0],(8,5)), + ([0,0,0,0,1,0,0,1,0,0,0],(8,6)), + ([0,0,0,0,0,1,0,1,0,1,1,1],(8,7)), + ([0,0,0,0,0,1,0,0,1,1,1,0],(8,8)), + ([0,0,0,0,0,0,1,1,1,1,0,1],(8,9)), + ([0,0,0,0,0,0,1,0,1,1,1,0],(8,10)), + ([0,0,0,0,0,0,0,1,1,0,1,1,0],(8,11)), + ([0,0,0,0,0,0,0,1,0,0,1,0,1],(8,12)), + ([0,0,0,0,0,0,0,0,0,1,1,1,1,0],(8,13)), + ([0,0,0,0,0,0,0,0,0,0,1,0,1,0,0],(8,14)), + ([0,0,0,0,0,0,0,0,0,0,1,0,0,0,0],(8,15)), + ([0,0,0,0,1,1,0,1,0,1],(9,0)), + ([0,0,0,0,1,1,0,0,1],(9,1)), + ([0,0,0,0,1,0,1,0,0,1],(9,2)), + ([0,0,0,0,1,0,0,1,0,1],(9,3)), + ([0,0,0,0,0,1,0,1,1,0,0],(9,4)), + ([0,0,0,0,0,1,1,1,0,1,1],(9,5)), + ([0,0,0,0,0,1,1,0,1,1,0],(9,6)), + ([0,0,0,0,0,0,1,0,1,0,0,0,1],(9,7)), + ([0,0,0,0,0,1,0,0,0,0,1,0],(9,8)), + ([0,0,0,0,0,0,1,0,0,1,1,0,0],(9,9)), + ([0,0,0,0,0,0,0,1,1,1,0,0,1],(9,10)), + ([0,0,0,0,0,0,0,0,1,1,0,1,1,0],(9,11)), + ([0,0,0,0,0,0,0,0,1,0,0,1,0,1],(9,12)), + ([0,0,0,0,0,0,0,0,0,1,0,0,1,0],(9,13)), + ([0,0,0,0,0,0,0,0,0,0,1,0,0,1,1,1],(9,14)), + ([0,0,0,0,0,0,0,0,0,0,0,1,0,1,1],(9,15)), + ([0,0,0,0,1,0,0,0,1,1],(10,0)), + ([0,0,0,0,1,0,0,0,0,1],(10,1)), + ([0,0,0,0,0,1,1,1,1,1],(10,2)), + ([0,0,0,0,0,1,1,1,0,0,1],(10,3)), + ([0,0,0,0,0,1,0,1,0,1,0],(10,4)), + ([0,0,0,0,0,1,0,1,0,0,1,0],(10,5)), + ([0,0,0,0,0,1,0,0,1,0,0,0],(10,6)), + ([0,0,0,0,0,0,1,0,1,0,0,0,0],(10,7)), + ([0,0,0,0,0,0,1,0,1,1,1,1],(10,8)), + ([0,0,0,0,0,0,0,1,1,1,0,1,0],(10,9)), + ([0,0,0,0,0,0,0,0,1,1,0,1,1,1],(10,10)), + ([0,0,0,0,0,0,0,0,1,0,1,0,1],(10,11)), + ([0,0,0,0,0,0,0,0,0,1,0,1,1,0],(10,12)), + ([0,0,0,0,0,0,0,0,0,0,1,1,0,1,0],(10,13)), + ([0,0,0,0,0,0,0,0,0,0,1,0,0,1,1,0],(10,14)), + ([0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,1,0],(10,15)), + ([0,0,0,0,0,1,1,0,1,0,1],(11,0)), + ([0,0,0,0,0,1,1,0,0,1],(11,1)), + ([0,0,0,0,0,1,0,1,1,1],(11,2)), + ([0,0,0,0,0,1,0,0,1,1,0],(11,3)), + ([0,0,0,0,0,1,0,0,0,1,1,0],(11,4)), + ([0,0,0,0,0,0,1,1,1,1,0,0],(11,5)), + ([0,0,0,0,0,0,1,1,0,0,1,1],(11,6)), + ([0,0,0,0,0,0,1,0,0,1,0,0],(11,7)), + ([0,0,0,0,0,0,0,1,1,0,1,1,1],(11,8)), + ([0,0,0,0,0,0,0,0,1,1,0,1,0],(11,9)), + ([0,0,0,0,0,0,0,1,0,0,0,1,0],(11,10)), + ([0,0,0,0,0,0,0,0,0,1,0,1,1,1],(11,11)), + ([0,0,0,0,0,0,0,0,0,0,1,1,0,1,1],(11,12)), + ([0,0,0,0,0,0,0,0,0,0,0,1,1,1,0],(11,13)), + ([0,0,0,0,0,0,0,0,0,0,0,1,0,0,1],(11,14)), + ([0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1],(11,15)), + ([0,0,0,0,0,1,0,0,0,1,0],(12,0)), + ([0,0,0,0,0,1,0,0,0,0,0],(12,1)), + ([0,0,0,0,0,0,1,1,1,0,0],(12,2)), + ([0,0,0,0,0,0,1,0,0,1,1,1],(12,3)), + ([0,0,0,0,0,0,1,1,0,0,0,1],(12,4)), + ([0,0,0,0,0,0,1,0,0,1,0,1,1],(12,5)), + ([0,0,0,0,0,0,0,1,1,1,1,0],(12,6)), + ([0,0,0,0,0,0,0,1,1,0,1,0,0],(12,7)), + ([0,0,0,0,0,0,0,0,1,1,0,0,0,0],(12,8)), + ([0,0,0,0,0,0,0,0,1,0,1,0,0,0],(12,9)), + ([0,0,0,0,0,0,0,0,0,1,1,0,1,0,0],(12,10)), + ([0,0,0,0,0,0,0,0,0,0,1,1,1,0,0],(12,11)), + ([0,0,0,0,0,0,0,0,0,0,1,0,0,1,0],(12,12)), + ([0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1],(12,13)), + ([0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,1],(12,14)), + ([0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1],(12,15)), + ([0,0,0,0,0,0,1,0,1,1,0,1],(13,0)), + ([0,0,0,0,0,0,1,0,1,0,1],(13,1)), + ([0,0,0,0,0,0,1,0,0,0,1,0],(13,2)), + ([0,0,0,0,0,0,1,0,0,0,0,0,0],(13,3)), + ([0,0,0,0,0,0,0,1,1,1,0,0,0],(13,4)), + ([0,0,0,0,0,0,0,1,1,0,0,1,0],(13,5)), + ([0,0,0,0,0,0,0,0,1,1,0,0,0,1],(13,6)), + ([0,0,0,0,0,0,0,0,1,0,1,1,0,1],(13,7)), + ([0,0,0,0,0,0,0,0,0,1,1,1,1,1],(13,8)), + ([0,0,0,0,0,0,0,0,0,1,0,0,1,1],(13,9)), + ([0,0,0,0,0,0,0,0,0,0,1,1,0,0],(13,10)), + ([0,0,0,0,0,0,0,0,0,0,0,1,1,1,1],(13,11)), + ([0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0],(13,12)), + ([0,0,0,0,0,0,0,0,0,0,0,0,1,1,1],(13,13)), + ([0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0],(13,14)), + ([0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1],(13,15)), + ([0,0,0,0,0,0,0,1,1,0,0,0,0],(14,0)), + ([0,0,0,0,0,0,0,1,0,1,1,1],(14,1)), + ([0,0,0,0,0,0,0,1,0,1,0,0],(14,2)), + ([0,0,0,0,0,0,0,1,0,0,1,1,1],(14,3)), + ([0,0,0,0,0,0,0,1,0,0,1,0,0],(14,4)), + ([0,0,0,0,0,0,0,1,0,0,0,1,1],(14,5)), + ([0,0,0,0,0,0,0,0,0,1,1,0,1,0,1],(14,6)), + ([0,0,0,0,0,0,0,0,0,1,0,1,0,1],(14,7)), + ([0,0,0,0,0,0,0,0,0,1,0,0,0,0],(14,8)), + ([0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,1,1],(14,9)), + ([0,0,0,0,0,0,0,0,0,0,0,1,1,0,1],(14,10)), + ([0,0,0,0,0,0,0,0,0,0,0,1,0,1,0],(14,11)), + ([0,0,0,0,0,0,0,0,0,0,0,0,1,1,0],(14,12)), + ([0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1],(14,13)), + ([0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0],(14,14)), + ([0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0],(14,15)), + ([0,0,0,0,0,0,0,1,0,0,0,0],(15,0)), + ([0,0,0,0,0,0,0,0,1,1,1,1],(15,1)), + ([0,0,0,0,0,0,0,0,1,0,0,0,1],(15,2)), + ([0,0,0,0,0,0,0,0,0,1,1,0,1,1],(15,3)), + ([0,0,0,0,0,0,0,0,0,1,1,0,0,1],(15,4)), + ([0,0,0,0,0,0,0,0,0,1,0,1,0,0],(15,5)), + ([0,0,0,0,0,0,0,0,0,0,1,1,1,0,1],(15,6)), + ([0,0,0,0,0,0,0,0,0,0,1,0,1,1],(15,7)), + ([0,0,0,0,0,0,0,0,0,0,1,0,0,0,1],(15,8)), + ([0,0,0,0,0,0,0,0,0,0,0,1,1,0,0],(15,9)), + ([0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0],(15,10)), + ([0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0],(15,11)), + ([0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1],(15,12)), + ([0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1],(15,13)), + ([0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],(15,14)), + ([0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1],(15,15))] + +tableHuffR12 :: [([Int], (Int, Int))] +tableHuffR12 = [([1,1,1],(0,0)), + ([1,1,0,0],(0,1)), + ([1,0,0,1,0],(0,2)), + ([0,1,1,0,1,0,1],(0,3)), + ([0,1,0,1,1,1,1],(0,4)), + ([0,1,0,0,1,1,0,0],(0,5)), + ([0,0,1,1,1,1,1,0,0],(0,6)), + ([0,0,1,1,0,1,1,0,0],(0,7)), + ([0,0,1,0,1,1,0,0,1],(0,8)), + ([0,0,0,1,1,1,1,0,1,1],(0,9)), + ([0,0,0,1,1,0,1,1,0,0],(0,10)), + ([0,0,0,0,1,1,1,0,1,1,1],(0,11)), + ([0,0,0,0,1,1,0,1,0,1,1],(0,12)), + ([0,0,0,0,1,0,1,0,0,0,1],(0,13)), + ([0,0,0,0,0,1,1,1,1,0,1,0],(0,14)), + ([0,0,0,0,0,0,0,1,1,1,1,1,1],(0,15)), + ([1,1,0,1],(1,0)), + ([1,0,1],(1,1)), + ([1,0,0,0,0],(1,2)), + ([0,1,1,0,1,1],(1,3)), + ([0,1,0,1,1,1,0],(1,4)), + ([0,1,0,0,1,0,0],(1,5)), + ([0,0,1,1,1,1,0,1],(1,6)), + ([0,0,1,1,0,0,1,1],(1,7)), + ([0,0,1,0,1,0,1,0],(1,8)), + ([0,0,1,0,0,0,1,1,0],(1,9)), + ([0,0,0,1,1,0,1,0,0],(1,10)), + ([0,0,0,1,0,1,0,0,1,1],(1,11)), + ([0,0,0,1,0,0,0,0,0,1],(1,12)), + ([0,0,0,0,1,0,1,0,0,1],(1,13)), + ([0,0,0,0,0,1,1,1,0,1,1],(1,14)), + ([0,0,0,0,0,1,0,0,1,0,0],(1,15)), + ([1,0,0,1,1],(2,0)), + ([1,0,0,0,1],(2,1)), + ([0,1,1,1,1],(2,2)), + ([0,1,1,0,0,0],(2,3)), + ([0,1,0,1,0,0,1],(2,4)), + ([0,1,0,0,0,1,0],(2,5)), + ([0,0,1,1,1,0,1,1],(2,6)), + ([0,0,1,1,0,0,0,0],(2,7)), + ([0,0,1,0,1,0,0,0],(2,8)), + ([0,0,1,0,0,0,0,0,0],(2,9)), + ([0,0,0,1,1,0,0,1,0],(2,10)), + ([0,0,0,1,0,0,1,1,1,0],(2,11)), + ([0,0,0,0,1,1,1,1,1,0],(2,12)), + ([0,0,0,0,1,0,1,0,0,0,0],(2,13)), + ([0,0,0,0,0,1,1,1,0,0,0],(2,14)), + ([0,0,0,0,0,1,0,0,0,0,1],(2,15)), + ([0,1,1,1,0,1],(3,0)), + ([0,1,1,1,0,0],(3,1)), + ([0,1,1,0,0,1],(3,2)), + ([0,1,0,1,0,1,1],(3,3)), + ([0,1,0,0,1,1,1],(3,4)), + ([0,0,1,1,1,1,1,1],(3,5)), + ([0,0,1,1,0,1,1,1],(3,6)), + ([0,0,1,0,1,1,1,0,1],(3,7)), + ([0,0,1,0,0,1,1,0,0],(3,8)), + ([0,0,0,1,1,1,0,1,1],(3,9)), + ([0,0,0,1,0,1,1,1,0,1],(3,10)), + ([0,0,0,1,0,0,1,0,0,0],(3,11)), + ([0,0,0,0,1,1,0,1,1,0],(3,12)), + ([0,0,0,0,1,0,0,1,0,1,1],(3,13)), + ([0,0,0,0,0,1,1,0,0,1,0],(3,14)), + ([0,0,0,0,0,0,1,1,1,0,1],(3,15)), + ([0,1,1,0,1,0,0],(4,0)), + ([0,1,0,1,1,0],(4,1)), + ([0,1,0,1,0,1,0],(4,2)), + ([0,1,0,1,0,0,0],(4,3)), + ([0,1,0,0,0,0,1,1],(4,4)), + ([0,0,1,1,1,0,0,1],(4,5)), + ([0,0,1,0,1,1,1,1,1],(4,6)), + ([0,0,1,0,0,1,1,1,1],(4,7)), + ([0,0,1,0,0,1,0,0,0],(4,8)), + ([0,0,0,1,1,1,0,0,1],(4,9)), + ([0,0,0,1,0,1,1,0,0,1],(4,10)), + ([0,0,0,1,0,0,0,1,0,1],(4,11)), + ([0,0,0,0,1,1,0,0,0,1],(4,12)), + ([0,0,0,0,1,0,0,0,0,1,0],(4,13)), + ([0,0,0,0,0,1,0,1,1,1,0],(4,14)), + ([0,0,0,0,0,0,1,1,0,1,1],(4,15)), + ([0,1,0,0,1,1,0,1],(5,0)), + ([0,1,0,0,1,0,1],(5,1)), + ([0,1,0,0,0,1,1],(5,2)), + ([0,1,0,0,0,0,1,0],(5,3)), + ([0,0,1,1,1,0,1,0],(5,4)), + ([0,0,1,1,0,1,0,0],(5,5)), + ([0,0,1,0,1,1,0,1,1],(5,6)), + ([0,0,1,0,0,1,0,1,0],(5,7)), + ([0,0,0,1,1,1,1,1,0],(5,8)), + ([0,0,0,1,1,0,0,0,0],(5,9)), + ([0,0,0,1,0,0,1,1,1,1],(5,10)), + ([0,0,0,0,1,1,1,1,1,1],(5,11)), + ([0,0,0,0,1,0,1,1,0,1,0],(5,12)), + ([0,0,0,0,0,1,1,1,1,1,0],(5,13)), + ([0,0,0,0,0,1,0,1,0,0,0],(5,14)), + ([0,0,0,0,0,0,1,0,0,1,1,0],(5,15)), + ([0,0,1,1,1,1,1,0,1],(6,0)), + ([0,1,0,0,0,0,0],(6,1)), + ([0,0,1,1,1,1,0,0],(6,2)), + ([0,0,1,1,1,0,0,0],(6,3)), + ([0,0,1,1,0,0,1,0],(6,4)), + ([0,0,1,0,1,1,1,0,0],(6,5)), + ([0,0,1,0,0,1,1,1,0],(6,6)), + ([0,0,1,0,0,0,0,0,1],(6,7)), + ([0,0,0,1,1,0,1,1,1],(6,8)), + ([0,0,0,1,0,1,0,1,1,1],(6,9)), + ([0,0,0,1,0,0,0,1,1,1],(6,10)), + ([0,0,0,0,1,1,0,0,1,1],(6,11)), + ([0,0,0,0,1,0,0,1,0,0,1],(6,12)), + ([0,0,0,0,0,1,1,0,0,1,1],(6,13)), + ([0,0,0,0,0,1,0,0,0,1,1,0],(6,14)), + ([0,0,0,0,0,0,0,1,1,1,1,0],(6,15)), + ([0,0,1,1,0,1,1,0,1],(7,0)), + ([0,0,1,1,0,1,0,1],(7,1)), + ([0,0,1,1,0,0,0,1],(7,2)), + ([0,0,1,0,1,1,1,1,0],(7,3)), + ([0,0,1,0,1,1,0,0,0],(7,4)), + ([0,0,1,0,0,1,0,1,1],(7,5)), + ([0,0,1,0,0,0,0,1,0],(7,6)), + ([0,0,0,1,1,1,1,0,1,0],(7,7)), + ([0,0,0,1,0,1,1,0,1,1],(7,8)), + ([0,0,0,1,0,0,1,0,0,1],(7,9)), + ([0,0,0,0,1,1,1,0,0,0],(7,10)), + ([0,0,0,0,1,0,1,0,1,0],(7,11)), + ([0,0,0,0,1,0,0,0,0,0,0],(7,12)), + ([0,0,0,0,0,1,0,1,1,0,0],(7,13)), + ([0,0,0,0,0,0,1,0,1,0,1],(7,14)), + ([0,0,0,0,0,0,0,1,1,0,0,1],(7,15)), + ([0,0,1,0,1,1,0,1,0],(8,0)), + ([0,0,1,0,1,0,1,1],(8,1)), + ([0,0,1,0,1,0,0,1],(8,2)), + ([0,0,1,0,0,1,1,0,1],(8,3)), + ([0,0,1,0,0,1,0,0,1],(8,4)), + ([0,0,0,1,1,1,1,1,1],(8,5)), + ([0,0,0,1,1,1,0,0,0],(8,6)), + ([0,0,0,1,0,1,1,1,0,0],(8,7)), + ([0,0,0,1,0,0,1,1,0,1],(8,8)), + ([0,0,0,1,0,0,0,0,1,0],(8,9)), + ([0,0,0,0,1,0,1,1,1,1],(8,10)), + ([0,0,0,0,1,0,0,0,0,1,1],(8,11)), + ([0,0,0,0,0,1,1,0,0,0,0],(8,12)), + ([0,0,0,0,0,0,1,1,0,1,0,1],(8,13)), + ([0,0,0,0,0,0,1,0,0,1,0,0],(8,14)), + ([0,0,0,0,0,0,0,1,0,1,0,0],(8,15)), + ([0,0,1,0,0,0,1,1,1],(9,0)), + ([0,0,1,0,0,0,1,0],(9,1)), + ([0,0,1,0,0,0,0,1,1],(9,2)), + ([0,0,0,1,1,1,1,0,0],(9,3)), + ([0,0,0,1,1,1,0,1,0],(9,4)), + ([0,0,0,1,1,0,0,0,1],(9,5)), + ([0,0,0,1,0,1,1,0,0,0],(9,6)), + ([0,0,0,1,0,0,1,1,0,0],(9,7)), + ([0,0,0,1,0,0,0,0,1,1],(9,8)), + ([0,0,0,0,1,1,0,1,0,1,0],(9,9)), + ([0,0,0,0,1,0,0,0,1,1,1],(9,10)), + ([0,0,0,0,0,1,1,0,1,1,0],(9,11)), + ([0,0,0,0,0,1,0,0,1,1,0],(9,12)), + ([0,0,0,0,0,0,1,0,0,1,1,1],(9,13)), + ([0,0,0,0,0,0,0,1,0,1,1,1],(9,14)), + ([0,0,0,0,0,0,0,0,1,1,1,1],(9,15)), + ([0,0,0,1,1,0,1,1,0,1],(10,0)), + ([0,0,0,1,1,0,1,0,1],(10,1)), + ([0,0,0,1,1,0,0,1,1],(10,2)), + ([0,0,0,1,0,1,1,1,1],(10,3)), + ([0,0,0,1,0,1,1,0,1,0],(10,4)), + ([0,0,0,1,0,1,0,0,1,0],(10,5)), + ([0,0,0,0,1,1,1,0,1,0],(10,6)), + ([0,0,0,0,1,1,1,0,0,1],(10,7)), + ([0,0,0,0,1,1,0,0,0,0],(10,8)), + ([0,0,0,0,1,0,0,1,0,0,0],(10,9)), + ([0,0,0,0,0,1,1,1,0,0,1],(10,10)), + ([0,0,0,0,0,1,0,1,0,0,1],(10,11)), + ([0,0,0,0,0,0,1,0,1,1,1],(10,12)), + ([0,0,0,0,0,0,0,1,1,0,1,1],(10,13)), + ([0,0,0,0,0,0,0,1,1,1,1,1,0],(10,14)), + ([0,0,0,0,0,0,0,0,1,0,0,1],(10,15)), + ([0,0,0,1,0,1,0,1,1,0],(11,0)), + ([0,0,0,1,0,1,0,1,0],(11,1)), + ([0,0,0,1,0,1,0,0,0],(11,2)), + ([0,0,0,1,0,0,1,0,1],(11,3)), + ([0,0,0,1,0,0,0,1,1,0],(11,4)), + ([0,0,0,1,0,0,0,0,0,0],(11,5)), + ([0,0,0,0,1,1,0,1,0,0],(11,6)), + ([0,0,0,0,1,0,1,0,1,1],(11,7)), + ([0,0,0,0,1,0,0,0,1,1,0],(11,8)), + ([0,0,0,0,0,1,1,0,1,1,1],(11,9)), + ([0,0,0,0,0,1,0,1,0,1,0],(11,10)), + ([0,0,0,0,0,0,1,1,0,0,1],(11,11)), + ([0,0,0,0,0,0,0,1,1,1,0,1],(11,12)), + ([0,0,0,0,0,0,0,1,0,0,1,0],(11,13)), + ([0,0,0,0,0,0,0,0,1,0,1,1],(11,14)), + ([0,0,0,0,0,0,0,0,0,1,0,1,1],(11,15)), + ([0,0,0,0,1,1,1,0,1,1,0],(12,0)), + ([0,0,0,1,0,0,0,1,0,0],(12,1)), + ([0,0,0,0,1,1,1,1,0],(12,2)), + ([0,0,0,0,1,1,0,1,1,1],(12,3)), + ([0,0,0,0,1,1,0,0,1,0],(12,4)), + ([0,0,0,0,1,0,1,1,1,0],(12,5)), + ([0,0,0,0,1,0,0,1,0,1,0],(12,6)), + ([0,0,0,0,1,0,0,0,0,0,1],(12,7)), + ([0,0,0,0,0,1,1,0,0,0,1],(12,8)), + ([0,0,0,0,0,1,0,0,1,1,1],(12,9)), + ([0,0,0,0,0,0,1,1,0,0,0],(12,10)), + ([0,0,0,0,0,0,1,0,0,0,0],(12,11)), + ([0,0,0,0,0,0,0,1,0,1,1,0],(12,12)), + ([0,0,0,0,0,0,0,0,1,1,0,1],(12,13)), + ([0,0,0,0,0,0,0,0,0,1,1,1,0],(12,14)), + ([0,0,0,0,0,0,0,0,0,0,1,1,1],(12,15)), + ([0,0,0,0,1,0,1,1,0,1,1],(13,0)), + ([0,0,0,0,1,0,1,1,0,0],(13,1)), + ([0,0,0,0,1,0,0,1,1,1],(13,2)), + ([0,0,0,0,1,0,0,1,1,0],(13,3)), + ([0,0,0,0,1,0,0,0,1,0],(13,4)), + ([0,0,0,0,0,1,1,1,1,1,1],(13,5)), + ([0,0,0,0,0,1,1,0,1,0,0],(13,6)), + ([0,0,0,0,0,1,0,1,1,0,1],(13,7)), + ([0,0,0,0,0,0,1,1,1,1,1],(13,8)), + ([0,0,0,0,0,0,1,1,0,1,0,0],(13,9)), + ([0,0,0,0,0,0,0,1,1,1,0,0],(13,10)), + ([0,0,0,0,0,0,0,1,0,0,1,1],(13,11)), + ([0,0,0,0,0,0,0,0,1,1,1,0],(13,12)), + ([0,0,0,0,0,0,0,0,1,0,0,0],(13,13)), + ([0,0,0,0,0,0,0,0,0,1,0,0,1],(13,14)), + ([0,0,0,0,0,0,0,0,0,0,0,1,1],(13,15)), + ([0,0,0,0,0,1,1,1,1,0,1,1],(14,0)), + ([0,0,0,0,0,1,1,1,1,0,0],(14,1)), + ([0,0,0,0,0,1,1,1,0,1,0],(14,2)), + ([0,0,0,0,0,1,1,0,1,0,1],(14,3)), + ([0,0,0,0,0,1,0,1,1,1,1],(14,4)), + ([0,0,0,0,0,1,0,1,0,1,1],(14,5)), + ([0,0,0,0,0,1,0,0,0,0,0],(14,6)), + ([0,0,0,0,0,0,1,0,1,1,0],(14,7)), + ([0,0,0,0,0,0,1,0,0,1,0,1],(14,8)), + ([0,0,0,0,0,0,0,1,1,0,0,0],(14,9)), + ([0,0,0,0,0,0,0,1,0,0,0,1],(14,10)), + ([0,0,0,0,0,0,0,0,1,1,0,0],(14,11)), + ([0,0,0,0,0,0,0,0,0,1,1,1,1],(14,12)), + ([0,0,0,0,0,0,0,0,0,1,0,1,0],(14,13)), + ([0,0,0,0,0,0,0,0,0,0,1,0],(14,14)), + ([0,0,0,0,0,0,0,0,0,0,0,0,1],(14,15)), + ([0,0,0,0,0,1,0,0,0,1,1,1],(15,0)), + ([0,0,0,0,0,1,0,0,1,0,1],(15,1)), + ([0,0,0,0,0,1,0,0,0,1,0],(15,2)), + ([0,0,0,0,0,0,1,1,1,1,0],(15,3)), + ([0,0,0,0,0,0,1,1,1,0,0],(15,4)), + ([0,0,0,0,0,0,1,0,1,0,0],(15,5)), + ([0,0,0,0,0,0,1,0,0,0,1],(15,6)), + ([0,0,0,0,0,0,0,1,1,0,1,0],(15,7)), + ([0,0,0,0,0,0,0,1,0,1,0,1],(15,8)), + ([0,0,0,0,0,0,0,1,0,0,0,0],(15,9)), + ([0,0,0,0,0,0,0,0,1,0,1,0],(15,10)), + ([0,0,0,0,0,0,0,0,0,1,1,0],(15,11)), + ([0,0,0,0,0,0,0,0,0,1,0,0,0],(15,12)), + ([0,0,0,0,0,0,0,0,0,0,1,1,0],(15,13)), + ([0,0,0,0,0,0,0,0,0,0,0,1,0],(15,14)), + ([0,0,0,0,0,0,0,0,0,0,0,0,0],(15,15))] + +tableHuffR13 :: [([Int], (Int, Int))] +tableHuffR13 = [([1],(0,0)), + ([0,1,0,1],(0,1)), + ([0,0,1,1,1,0],(0,2)), + ([0,0,1,0,1,1,0,0],(0,3)), + ([0,0,1,0,0,1,0,1,0],(0,4)), + ([0,0,0,1,1,1,1,1,1],(0,5)), + ([0,0,0,1,1,0,1,1,1,0],(0,6)), + ([0,0,0,1,0,1,1,1,0,1],(0,7)), + ([0,0,0,1,0,1,0,1,1,0,0],(0,8)), + ([0,0,0,1,0,0,1,0,1,0,1],(0,9)), + ([0,0,0,1,0,0,0,1,0,1,0],(0,10)), + ([0,0,0,0,1,1,1,1,0,0,1,0],(0,11)), + ([0,0,0,0,1,1,1,0,0,0,0,1],(0,12)), + ([0,0,0,0,1,1,0,0,0,0,1,1],(0,13)), + ([0,0,0,0,1,0,1,1,1,1,0,0,0],(0,14)), + ([0,0,0,0,1,0,0,0,1],(0,15)), + ([0,1,1],(1,0)), + ([0,1,0,0],(1,1)), + ([0,0,1,1,0,0],(1,2)), + ([0,0,1,0,1,0,0],(1,3)), + ([0,0,1,0,0,0,1,1],(1,4)), + ([0,0,0,1,1,1,1,1,0],(1,5)), + ([0,0,0,1,1,0,1,0,1],(1,6)), + ([0,0,0,1,0,1,1,1,1],(1,7)), + ([0,0,0,1,0,1,0,0,1,1],(1,8)), + ([0,0,0,1,0,0,1,0,1,1],(1,9)), + ([0,0,0,1,0,0,0,1,0,0],(1,10)), + ([0,0,0,0,1,1,1,0,1,1,1],(1,11)), + ([0,0,0,0,1,1,0,0,1,0,0,1],(1,12)), + ([0,0,0,0,1,1,0,1,0,1,1],(1,13)), + ([0,0,0,0,1,1,0,0,1,1,1,1],(1,14)), + ([0,0,0,0,1,0,0,1],(1,15)), + ([0,0,1,1,1,1],(2,0)), + ([0,0,1,1,0,1],(2,1)), + ([0,0,1,0,1,1,1],(2,2)), + ([0,0,1,0,0,1,1,0],(2,3)), + ([0,0,1,0,0,0,0,1,1],(2,4)), + ([0,0,0,1,1,1,0,1,0],(2,5)), + ([0,0,0,1,1,0,0,1,1,1],(2,6)), + ([0,0,0,1,0,1,1,0,1,0],(2,7)), + ([0,0,0,1,0,1,0,0,0,0,1],(2,8)), + ([0,0,0,1,0,0,1,0,0,0],(2,9)), + ([0,0,0,0,1,1,1,1,1,1,1],(2,10)), + ([0,0,0,0,1,1,1,0,1,0,1],(2,11)), + ([0,0,0,0,1,1,0,1,1,1,0],(2,12)), + ([0,0,0,0,1,1,0,1,0,0,0,1],(2,13)), + ([0,0,0,0,1,1,0,0,1,1,1,0],(2,14)), + ([0,0,0,0,1,0,0,0,0],(2,15)), + ([0,0,1,0,1,1,0,1],(3,0)), + ([0,0,1,0,1,0,1],(3,1)), + ([0,0,1,0,0,1,1,1],(3,2)), + ([0,0,1,0,0,0,1,0,1],(3,3)), + ([0,0,1,0,0,0,0,0,0],(3,4)), + ([0,0,0,1,1,1,0,0,1,0],(3,5)), + ([0,0,0,1,1,0,0,0,1,1],(3,6)), + ([0,0,0,1,0,1,0,1,1,1],(3,7)), + ([0,0,0,1,0,0,1,1,1,1,0],(3,8)), + ([0,0,0,1,0,0,0,1,1,0,0],(3,9)), + ([0,0,0,0,1,1,1,1,1,1,0,0],(3,10)), + ([0,0,0,0,1,1,0,1,0,1,0,0],(3,11)), + ([0,0,0,0,1,1,0,0,0,1,1,1],(3,12)), + ([0,0,0,0,1,1,0,0,0,0,0,1,1],(3,13)), + ([0,0,0,0,1,0,1,1,0,1,1,0,1],(3,14)), + ([0,0,0,0,0,1,1,0,1,0],(3,15)), + ([0,0,1,0,0,1,0,1,1],(4,0)), + ([0,0,1,0,0,1,0,0],(4,1)), + ([0,0,1,0,0,0,1,0,0],(4,2)), + ([0,0,1,0,0,0,0,0,1],(4,3)), + ([0,0,0,1,1,1,0,0,1,1],(4,4)), + ([0,0,0,1,1,0,0,1,0,1],(4,5)), + ([0,0,0,1,0,1,1,0,0,1,1],(4,6)), + ([0,0,0,1,0,1,0,0,1,0,0],(4,7)), + ([0,0,0,1,0,0,1,1,0,1,1],(4,8)), + ([0,0,0,1,0,0,0,0,1,0,0,0],(4,9)), + ([0,0,0,0,1,1,1,1,0,1,1,0],(4,10)), + ([0,0,0,0,1,1,1,0,0,0,1,0],(4,11)), + ([0,0,0,0,1,1,0,0,0,1,0,1,1],(4,12)), + ([0,0,0,0,1,0,1,1,1,1,1,1,0],(4,13)), + ([0,0,0,0,1,0,1,1,0,1,0,1,0],(4,14)), + ([0,0,0,0,0,1,0,0,1],(4,15)), + ([0,0,1,0,0,0,0,1,0],(5,0)), + ([0,0,0,1,1,1,1,0],(5,1)), + ([0,0,0,1,1,1,0,1,1],(5,2)), + ([0,0,0,1,1,1,0,0,0],(5,3)), + ([0,0,0,1,1,0,0,1,1,0],(5,4)), + ([0,0,0,1,0,1,1,1,0,0,1],(5,5)), + ([0,0,0,1,0,1,0,1,1,0,1],(5,6)), + ([0,0,0,1,0,0,0,0,1,0,0,1],(5,7)), + ([0,0,0,1,0,0,0,1,1,1,0],(5,8)), + ([0,0,0,0,1,1,1,1,1,1,0,1],(5,9)), + ([0,0,0,0,1,1,1,0,1,0,0,0],(5,10)), + ([0,0,0,0,1,1,0,0,1,0,0,0,0],(5,11)), + ([0,0,0,0,1,1,0,0,0,0,1,0,0],(5,12)), + ([0,0,0,0,1,0,1,1,1,1,0,1,0],(5,13)), + ([0,0,0,0,0,1,1,0,1,1,1,1,0,1],(5,14)), + ([0,0,0,0,0,1,0,0,0,0],(5,15)), + ([0,0,0,1,1,0,1,1,1,1],(6,0)), + ([0,0,0,1,1,0,1,1,0],(6,1)), + ([0,0,0,1,1,0,1,0,0],(6,2)), + ([0,0,0,1,1,0,0,1,0,0],(6,3)), + ([0,0,0,1,0,1,1,1,0,0,0],(6,4)), + ([0,0,0,1,0,1,1,0,0,1,0],(6,5)), + ([0,0,0,1,0,1,0,0,0,0,0],(6,6)), + ([0,0,0,1,0,0,0,0,1,0,1],(6,7)), + ([0,0,0,1,0,0,0,0,0,0,0,1],(6,8)), + ([0,0,0,0,1,1,1,1,0,1,0,0],(6,9)), + ([0,0,0,0,1,1,1,0,0,1,0,0],(6,10)), + ([0,0,0,0,1,1,0,1,1,0,0,1],(6,11)), + ([0,0,0,0,1,1,0,0,0,0,0,0,1],(6,12)), + ([0,0,0,0,1,0,1,1,0,1,1,1,0],(6,13)), + ([0,0,0,0,1,0,1,1,0,0,1,0,1,1],(6,14)), + ([0,0,0,0,0,0,1,0,1,0],(6,15)), + ([0,0,0,1,1,0,0,0,1,0],(7,0)), + ([0,0,0,1,1,0,0,0,0],(7,1)), + ([0,0,0,1,0,1,1,0,1,1],(7,2)), + ([0,0,0,1,0,1,1,0,0,0],(7,3)), + ([0,0,0,1,0,1,0,0,1,0,1],(7,4)), + ([0,0,0,1,0,0,1,1,1,0,1],(7,5)), + ([0,0,0,1,0,0,1,0,1,0,0],(7,6)), + ([0,0,0,1,0,0,0,0,0,1,0,1],(7,7)), + ([0,0,0,0,1,1,1,1,1,0,0,0],(7,8)), + ([0,0,0,0,1,1,0,0,1,0,1,1,1],(7,9)), + ([0,0,0,0,1,1,0,0,0,1,1,0,1],(7,10)), + ([0,0,0,0,1,0,1,1,1,0,1,0,0],(7,11)), + ([0,0,0,0,1,0,1,1,1,1,1,0,0],(7,12)), + ([0,0,0,0,0,1,1,0,1,1,1,1,0,0,1],(7,13)), + ([0,0,0,0,0,1,1,0,1,1,1,0,1,0,0],(7,14)), + ([0,0,0,0,0,0,1,0,0,0],(7,15)), + ([0,0,0,1,0,1,0,1,0,1],(8,0)), + ([0,0,0,1,0,1,0,1,0,0],(8,1)), + ([0,0,0,1,0,1,0,0,0,1],(8,2)), + ([0,0,0,1,0,0,1,1,1,1,1],(8,3)), + ([0,0,0,1,0,0,1,1,1,0,0],(8,4)), + ([0,0,0,1,0,0,0,1,1,1,1],(8,5)), + ([0,0,0,1,0,0,0,0,0,1,0,0],(8,6)), + ([0,0,0,0,1,1,1,1,1,0,0,1],(8,7)), + ([0,0,0,0,1,1,0,1,0,1,0,1,1],(8,8)), + ([0,0,0,0,1,1,0,0,1,0,0,0,1],(8,9)), + ([0,0,0,0,1,1,0,0,0,1,0,0,0],(8,10)), + ([0,0,0,0,1,0,1,1,1,1,1,1,1],(8,11)), + ([0,0,0,0,1,0,1,1,0,1,0,1,1,1],(8,12)), + ([0,0,0,0,1,0,1,1,0,0,1,0,0,1],(8,13)), + ([0,0,0,0,1,0,1,1,0,0,0,1,0,0],(8,14)), + ([0,0,0,0,0,0,0,1,1,1],(8,15)), + ([0,0,0,1,0,0,1,1,0,1,0],(9,0)), + ([0,0,0,1,0,0,1,1,0,0],(9,1)), + ([0,0,0,1,0,0,1,0,0,1],(9,2)), + ([0,0,0,1,0,0,0,1,1,0,1],(9,3)), + ([0,0,0,1,0,0,0,0,0,1,1],(9,4)), + ([0,0,0,1,0,0,0,0,0,0,0,0],(9,5)), + ([0,0,0,0,1,1,1,1,0,1,0,1],(9,6)), + ([0,0,0,0,1,1,0,1,0,1,0,1,0],(9,7)), + ([0,0,0,0,1,1,0,0,1,0,1,1,0],(9,8)), + ([0,0,0,0,1,1,0,0,0,1,0,1,0],(9,9)), + ([0,0,0,0,1,1,0,0,0,0,0,0,0],(9,10)), + ([0,0,0,0,1,0,1,1,0,1,1,1,1,1],(9,11)), + ([0,0,0,0,1,0,1,1,0,0,1,1,1],(9,12)), + ([0,0,0,0,1,0,1,1,0,0,0,1,1,0],(9,13)), + ([0,0,0,0,1,0,1,1,0,0,0,0,0],(9,14)), + ([0,0,0,0,0,0,0,1,0,1,1],(9,15)), + ([0,0,0,1,0,0,0,1,0,1,1],(10,0)), + ([0,0,0,1,0,0,0,0,0,0,1],(10,1)), + ([0,0,0,1,0,0,0,0,1,1],(10,2)), + ([0,0,0,0,1,1,1,1,1,0,1],(10,3)), + ([0,0,0,0,1,1,1,1,0,1,1,1],(10,4)), + ([0,0,0,0,1,1,1,0,1,0,0,1],(10,5)), + ([0,0,0,0,1,1,1,0,0,1,0,1],(10,6)), + ([0,0,0,0,1,1,0,1,1,0,1,1],(10,7)), + ([0,0,0,0,1,1,0,0,0,1,0,0,1],(10,8)), + ([0,0,0,0,1,0,1,1,1,0,0,1,1,1],(10,9)), + ([0,0,0,0,1,0,1,1,1,0,0,0,0,1],(10,10)), + ([0,0,0,0,1,0,1,1,0,1,0,0,0,0],(10,11)), + ([0,0,0,0,0,1,1,0,1,1,1,0,1,0,1],(10,12)), + ([0,0,0,0,0,1,1,0,1,1,1,0,0,1,0],(10,13)), + ([0,0,0,0,0,1,1,0,1,1,0,1,1,1],(10,14)), + ([0,0,0,0,0,0,0,1,0,0],(10,15)), + ([0,0,0,0,1,1,1,1,0,0,1,1],(11,0)), + ([0,0,0,0,1,1,1,1,0,0,0],(11,1)), + ([0,0,0,0,1,1,1,0,1,1,0],(11,2)), + ([0,0,0,0,1,1,1,0,0,1,1],(11,3)), + ([0,0,0,0,1,1,1,0,0,0,1,1],(11,4)), + ([0,0,0,0,1,1,0,1,1,1,1,1],(11,5)), + ([0,0,0,0,1,1,0,0,0,1,1,0,0],(11,6)), + ([0,0,0,0,1,0,1,1,1,0,1,0,1,0],(11,7)), + ([0,0,0,0,1,0,1,1,1,0,0,1,1,0],(11,8)), + ([0,0,0,0,1,0,1,1,1,0,0,0,0,0],(11,9)), + ([0,0,0,0,1,0,1,1,0,1,0,0,0,1],(11,10)), + ([0,0,0,0,1,0,1,1,0,0,1,0,0,0],(11,11)), + ([0,0,0,0,1,0,1,1,0,0,0,0,1,0],(11,12)), + ([0,0,0,0,0,1,1,0,1,1,1,1,1],(11,13)), + ([0,0,0,0,0,1,1,0,1,1,0,1,0,0],(11,14)), + ([0,0,0,0,0,0,0,0,1,1,0],(11,15)), + ([0,0,0,0,1,1,0,0,1,0,1,0],(12,0)), + ([0,0,0,0,1,1,1,0,0,0,0,0],(12,1)), + ([0,0,0,0,1,1,0,1,1,1,1,0],(12,2)), + ([0,0,0,0,1,1,0,1,1,0,1,0],(12,3)), + ([0,0,0,0,1,1,0,1,1,0,0,0],(12,4)), + ([0,0,0,0,1,1,0,0,0,0,1,0,1],(12,5)), + ([0,0,0,0,1,1,0,0,0,0,0,1,0],(12,6)), + ([0,0,0,0,1,0,1,1,1,1,1,0,1],(12,7)), + ([0,0,0,0,1,0,1,1,0,1,1,0,0],(12,8)), + ([0,0,0,0,0,1,1,0,1,1,1,1,0,0,0],(12,9)), + ([0,0,0,0,0,1,1,0,1,1,1,0,1,1],(12,10)), + ([0,0,0,0,1,0,1,1,0,0,0,0,1,1],(12,11)), + ([0,0,0,0,0,1,1,0,1,1,1,0,0,0],(12,12)), + ([0,0,0,0,0,1,1,0,1,1,0,1,0,1],(12,13)), + ([0,0,0,0,0,1,1,0,1,1,0,0,0,0,0,0],(12,14)), + ([0,0,0,0,0,0,0,0,1,0,0],(12,15)), + ([0,0,0,0,1,0,1,1,1,0,1,0,1,1],(13,0)), + ([0,0,0,0,1,1,0,1,0,0,1,1],(13,1)), + ([0,0,0,0,1,1,0,1,0,0,1,0],(13,2)), + ([0,0,0,0,1,1,0,1,0,0,0,0],(13,3)), + ([0,0,0,0,1,0,1,1,1,0,0,1,0],(13,4)), + ([0,0,0,0,1,0,1,1,1,1,0,1,1],(13,5)), + ([0,0,0,0,1,0,1,1,0,1,1,1,1,0],(13,6)), + ([0,0,0,0,1,0,1,1,0,1,0,0,1,1],(13,7)), + ([0,0,0,0,1,0,1,1,0,0,1,0,1,0],(13,8)), + ([0,0,0,0,0,1,1,0,1,1,0,0,0,1,1,1],(13,9)), + ([0,0,0,0,0,1,1,0,1,1,1,0,0,1,1],(13,10)), + ([0,0,0,0,0,1,1,0,1,1,0,1,1,0,1],(13,11)), + ([0,0,0,0,0,1,1,0,1,1,0,1,1,0,0],(13,12)), + ([0,0,0,0,0,1,1,0,1,1,0,0,0,0,0,1,1],(13,13)), + ([0,0,0,0,0,1,1,0,1,1,0,0,0,0,1],(13,14)), + ([0,0,0,0,0,0,0,0,0,1,0],(13,15)), + ([0,0,0,0,1,0,1,1,1,1,0,0,1],(14,0)), + ([0,0,0,0,1,0,1,1,1,0,0,0,1],(14,1)), + ([0,0,0,0,1,1,0,0,1,1,0],(14,2)), + ([0,0,0,0,1,0,1,1,1,0,1,1],(14,3)), + ([0,0,0,0,1,0,1,1,0,1,0,1,1,0],(14,4)), + ([0,0,0,0,1,0,1,1,0,1,0,0,1,0],(14,5)), + ([0,0,0,0,1,0,1,1,0,0,1,1,0],(14,6)), + ([0,0,0,0,1,0,1,1,0,0,0,1,1,1],(14,7)), + ([0,0,0,0,1,0,1,1,0,0,0,1,0,1],(14,8)), + ([0,0,0,0,0,1,1,0,1,1,0,0,0,1,0],(14,9)), + ([0,0,0,0,0,1,1,0,1,1,0,0,0,1,1,0],(14,10)), + ([0,0,0,0,0,1,1,0,1,1,0,0,1,1,1],(14,11)), + ([0,0,0,0,0,1,1,0,1,1,0,0,0,0,0,1,0],(14,12)), + ([0,0,0,0,0,1,1,0,1,1,0,0,1,1,0],(14,13)), + ([0,0,0,0,0,1,1,0,1,1,0,0,1,0],(14,14)), + ([0,0,0,0,0,0,0,0,0,0,0],(14,15)), + ([0,0,0,0,0,1,1,0,0],(15,0)), + ([0,0,0,0,1,0,1,0],(15,1)), + ([0,0,0,0,0,1,1,1],(15,2)), + ([0,0,0,0,0,1,0,1,1],(15,3)), + ([0,0,0,0,0,1,0,1,0],(15,4)), + ([0,0,0,0,0,1,0,0,0,1],(15,5)), + ([0,0,0,0,0,0,1,0,1,1],(15,6)), + ([0,0,0,0,0,0,1,0,0,1],(15,7)), + ([0,0,0,0,0,0,0,1,1,0,1],(15,8)), + ([0,0,0,0,0,0,0,1,1,0,0],(15,9)), + ([0,0,0,0,0,0,0,1,0,1,0],(15,10)), + ([0,0,0,0,0,0,0,0,1,1,1],(15,11)), + ([0,0,0,0,0,0,0,0,1,0,1],(15,12)), + ([0,0,0,0,0,0,0,0,0,1,1],(15,13)), + ([0,0,0,0,0,0,0,0,0,0,1],(15,14)), + ([0,0,0,0,0,0,1,1],(15,15))] + +tableHuffR14 :: [([Int], (Int, Int))] +tableHuffR14 = [([1,1,1,1],(0,0)), + ([1,1,0,1],(0,1)), + ([1,0,1,1,1,0],(0,2)), + ([1,0,1,0,0,0,0],(0,3)), + ([1,0,0,1,0,0,1,0],(0,4)), + ([1,0,0,0,0,0,1,1,0],(0,5)), + ([0,1,1,1,1,1,0,0,0],(0,6)), + ([0,1,1,0,1,1,0,0,1,0],(0,7)), + ([0,1,1,0,1,0,1,0,1,0],(0,8)), + ([0,1,0,1,0,0,1,1,1,0,1],(0,9)), + ([0,1,0,1,0,0,0,1,1,0,1],(0,10)), + ([0,1,0,1,0,0,0,1,0,0,1],(0,11)), + ([0,1,0,0,1,1,0,1,1,0,1],(0,12)), + ([0,1,0,0,0,0,0,0,1,0,1],(0,13)), + ([0,1,0,0,0,0,0,0,1,0,0,0],(0,14)), + ([0,0,1,0,1,1,0,0,0],(0,15)), + ([1,1,1,0],(1,0)), + ([1,1,0,0],(1,1)), + ([1,0,1,0,1],(1,2)), + ([1,0,0,1,1,0],(1,3)), + ([1,0,0,0,1,1,1],(1,4)), + ([1,0,0,0,0,0,1,0],(1,5)), + ([0,1,1,1,1,0,1,0],(1,6)), + ([0,1,1,0,1,1,0,0,0],(1,7)), + ([0,1,1,0,1,0,0,0,1],(1,8)), + ([0,1,1,0,0,0,1,1,0],(1,9)), + ([0,1,0,1,0,0,0,1,1,1],(1,10)), + ([0,1,0,1,0,1,1,0,0,1],(1,11)), + ([0,1,0,0,1,1,1,1,1,1],(1,12)), + ([0,1,0,0,1,0,1,0,0,1],(1,13)), + ([0,1,0,0,0,1,0,1,1,1],(1,14)), + ([0,0,1,0,1,0,1,0],(1,15)), + ([1,0,1,1,1,1],(2,0)), + ([1,0,1,1,0],(2,1)), + ([1,0,1,0,0,1],(2,2)), + ([1,0,0,1,0,1,0],(2,3)), + ([1,0,0,0,1,0,0],(2,4)), + ([1,0,0,0,0,0,0,0],(2,5)), + ([0,1,1,1,1,0,0,0],(2,6)), + ([0,1,1,0,1,1,1,0,1],(2,7)), + ([0,1,1,0,0,1,1,1,1],(2,8)), + ([0,1,1,0,0,0,0,1,0],(2,9)), + ([0,1,0,1,1,0,1,1,0],(2,10)), + ([0,1,0,1,0,1,0,1,0,0],(2,11)), + ([0,1,0,0,1,1,1,0,1,1],(2,12)), + ([0,1,0,0,1,0,0,1,1,1],(2,13)), + ([0,1,0,0,0,0,1,1,1,0,1],(2,14)), + ([0,0,1,0,0,1,0],(2,15)), + ([1,0,1,0,0,0,1],(3,0)), + ([1,0,0,1,1,1],(3,1)), + ([1,0,0,1,0,1,1],(3,2)), + ([1,0,0,0,1,1,0],(3,3)), + ([1,0,0,0,0,1,1,0],(3,4)), + ([0,1,1,1,1,1,0,1],(3,5)), + ([0,1,1,1,0,1,0,0],(3,6)), + ([0,1,1,0,1,1,1,0,0],(3,7)), + ([0,1,1,0,0,1,1,0,0],(3,8)), + ([0,1,0,1,1,1,1,1,0],(3,9)), + ([0,1,0,1,1,0,0,1,0],(3,10)), + ([0,1,0,1,0,0,0,1,0,1],(3,11)), + ([0,1,0,0,1,1,0,1,1,1],(3,12)), + ([0,1,0,0,1,0,0,1,0,1],(3,13)), + ([0,1,0,0,0,0,1,1,1,1],(3,14)), + ([0,0,1,0,0,0,0],(3,15)), + ([1,0,0,1,0,0,1,1],(4,0)), + ([1,0,0,1,0,0,0],(4,1)), + ([1,0,0,0,1,0,1],(4,2)), + ([1,0,0,0,0,1,1,1],(4,3)), + ([0,1,1,1,1,1,1,1],(4,4)), + ([0,1,1,1,0,1,1,0],(4,5)), + ([0,1,1,1,0,0,0,0],(4,6)), + ([0,1,1,0,1,0,0,1,0],(4,7)), + ([0,1,1,0,0,1,0,0,0],(4,8)), + ([0,1,0,1,1,1,1,0,0],(4,9)), + ([0,1,0,1,1,0,0,0,0,0],(4,10)), + ([0,1,0,1,0,0,0,0,1,1],(4,11)), + ([0,1,0,0,1,1,0,0,1,0],(4,12)), + ([0,1,0,0,0,1,1,1,0,1],(4,13)), + ([0,1,0,0,0,0,1,1,1,0,0],(4,14)), + ([0,0,0,1,1,1,0],(4,15)), + ([1,0,0,0,0,0,1,1,1],(5,0)), + ([1,0,0,0,0,1,0],(5,1)), + ([1,0,0,0,0,0,0,1],(5,2)), + ([0,1,1,1,1,1,1,0],(5,3)), + ([0,1,1,1,0,1,1,1],(5,4)), + ([0,1,1,1,0,0,1,0],(5,5)), + ([0,1,1,0,1,0,1,1,0],(5,6)), + ([0,1,1,0,0,1,0,1,0],(5,7)), + ([0,1,1,0,0,0,0,0,0],(5,8)), + ([0,1,0,1,1,0,1,0,0],(5,9)), + ([0,1,0,1,0,1,0,1,0,1],(5,10)), + ([0,1,0,0,1,1,1,1,0,1],(5,11)), + ([0,1,0,0,1,0,1,1,0,1],(5,12)), + ([0,1,0,0,0,1,1,0,0,1],(5,13)), + ([0,1,0,0,0,0,0,1,1,0],(5,14)), + ([0,0,0,1,1,0,0],(5,15)), + ([0,1,1,1,1,1,0,0,1],(6,0)), + ([0,1,1,1,1,0,1,1],(6,1)), + ([0,1,1,1,1,0,0,1],(6,2)), + ([0,1,1,1,0,1,0,1],(6,3)), + ([0,1,1,1,0,0,0,1],(6,4)), + ([0,1,1,0,1,0,1,1,1],(6,5)), + ([0,1,1,0,0,1,1,1,0],(6,6)), + ([0,1,1,0,0,0,0,1,1],(6,7)), + ([0,1,0,1,1,1,0,0,1],(6,8)), + ([0,1,0,1,0,1,1,0,1,1],(6,9)), + ([0,1,0,1,0,0,1,0,1,0],(6,10)), + ([0,1,0,0,1,1,0,1,0,0],(6,11)), + ([0,1,0,0,1,0,0,0,1,1],(6,12)), + ([0,1,0,0,0,1,0,0,0,0],(6,13)), + ([0,1,0,0,0,0,0,1,0,0,0],(6,14)), + ([0,0,0,1,0,1,0],(6,15)), + ([0,1,1,0,1,1,0,0,1,1],(7,0)), + ([0,1,1,1,0,0,1,1],(7,1)), + ([0,1,1,0,1,1,1,1],(7,2)), + ([0,1,1,0,1,1,0,1],(7,3)), + ([0,1,1,0,1,0,0,1,1],(7,4)), + ([0,1,1,0,0,1,0,1,1],(7,5)), + ([0,1,1,0,0,0,1,0,0],(7,6)), + ([0,1,0,1,1,1,0,1,1],(7,7)), + ([0,1,0,1,1,0,0,0,0,1],(7,8)), + ([0,1,0,1,0,0,1,1,0,0],(7,9)), + ([0,1,0,0,1,1,1,0,0,1],(7,10)), + ([0,1,0,0,1,0,1,0,1,0],(7,11)), + ([0,1,0,0,0,1,1,0,1,1],(7,12)), + ([0,1,0,0,0,0,1,0,0,1,1],(7,13)), + ([0,0,1,0,1,1,1,1,1,0,1],(7,14)), + ([0,0,0,1,0,0,0,1],(7,15)), + ([0,1,1,0,1,0,1,0,1,1],(8,0)), + ([0,1,1,0,1,0,1,0,0],(8,1)), + ([0,1,1,0,1,0,0,0,0],(8,2)), + ([0,1,1,0,0,1,1,0,1],(8,3)), + ([0,1,1,0,0,1,0,0,1],(8,4)), + ([0,1,1,0,0,0,0,0,1],(8,5)), + ([0,1,0,1,1,1,0,1,0],(8,6)), + ([0,1,0,1,1,0,0,0,1],(8,7)), + ([0,1,0,1,0,1,0,0,1],(8,8)), + ([0,1,0,1,0,0,0,0,0,0],(8,9)), + ([0,1,0,0,1,0,1,1,1,1],(8,10)), + ([0,1,0,0,0,1,1,1,1,0],(8,11)), + ([0,1,0,0,0,0,1,1,0,0],(8,12)), + ([0,1,0,0,0,0,0,0,0,1,0],(8,13)), + ([0,0,1,0,1,1,1,1,0,0,1],(8,14)), + ([0,0,0,1,0,0,0,0],(8,15)), + ([0,1,0,1,0,0,1,1,1,1],(9,0)), + ([0,1,1,0,0,0,1,1,1],(9,1)), + ([0,1,1,0,0,0,1,0,1],(9,2)), + ([0,1,0,1,1,1,1,1,1],(9,3)), + ([0,1,0,1,1,1,1,0,1],(9,4)), + ([0,1,0,1,1,0,1,0,1],(9,5)), + ([0,1,0,1,0,1,1,1,0],(9,6)), + ([0,1,0,1,0,0,1,1,0,1],(9,7)), + ([0,1,0,1,0,0,0,0,0,1],(9,8)), + ([0,1,0,0,1,1,0,0,0,1],(9,9)), + ([0,1,0,0,1,0,0,0,0,1],(9,10)), + ([0,1,0,0,0,1,0,0,1,1],(9,11)), + ([0,1,0,0,0,0,0,1,0,0,1],(9,12)), + ([0,0,1,0,1,1,1,1,0,1,1],(9,13)), + ([0,0,1,0,1,1,1,0,0,1,1],(9,14)), + ([0,0,0,0,1,0,1,1],(9,15)), + ([0,1,0,1,0,0,1,1,1,0,0],(10,0)), + ([0,1,0,1,1,1,0,0,0],(10,1)), + ([0,1,0,1,1,0,1,1,1],(10,2)), + ([0,1,0,1,1,0,0,1,1],(10,3)), + ([0,1,0,1,0,1,1,1,1],(10,4)), + ([0,1,0,1,0,1,1,0,0,0],(10,5)), + ([0,1,0,1,0,0,1,0,1,1],(10,6)), + ([0,1,0,0,1,1,1,0,1,0],(10,7)), + ([0,1,0,0,1,1,0,0,0,0],(10,8)), + ([0,1,0,0,1,0,0,0,1,0],(10,9)), + ([0,1,0,0,0,1,0,1,0,1],(10,10)), + ([0,1,0,0,0,0,1,0,0,1,0],(10,11)), + ([0,0,1,0,1,1,1,1,1,1,1],(10,12)), + ([0,0,1,0,1,1,1,0,1,0,1],(10,13)), + ([0,0,1,0,1,1,0,1,1,1,0],(10,14)), + ([0,0,0,0,1,0,1,0],(10,15)), + ([0,1,0,1,0,0,0,1,1,0,0],(11,0)), + ([0,1,0,1,0,1,1,0,1,0],(11,1)), + ([0,1,0,1,0,1,0,1,1],(11,2)), + ([0,1,0,1,0,1,0,0,0],(11,3)), + ([0,1,0,1,0,0,1,0,0],(11,4)), + ([0,1,0,0,1,1,1,1,1,0],(11,5)), + ([0,1,0,0,1,1,0,1,0,1],(11,6)), + ([0,1,0,0,1,0,1,0,1,1],(11,7)), + ([0,1,0,0,0,1,1,1,1,1],(11,8)), + ([0,1,0,0,0,1,0,1,0,0],(11,9)), + ([0,1,0,0,0,0,0,1,1,1],(11,10)), + ([0,1,0,0,0,0,0,0,0,0,1],(11,11)), + ([0,0,1,0,1,1,1,0,1,1,1],(11,12)), + ([0,0,1,0,1,1,1,0,0,0,0],(11,13)), + ([0,0,1,0,1,1,0,1,0,1,0],(11,14)), + ([0,0,0,0,0,1,1,0],(11,15)), + ([0,1,0,1,0,0,0,1,0,0,0],(12,0)), + ([0,1,0,1,0,0,0,0,1,0],(12,1)), + ([0,1,0,0,1,1,1,1,0,0],(12,2)), + ([0,1,0,0,1,1,1,0,0,0],(12,3)), + ([0,1,0,0,1,1,0,0,1,1],(12,4)), + ([0,1,0,0,1,0,1,1,1,0],(12,5)), + ([0,1,0,0,1,0,0,1,0,0],(12,6)), + ([0,1,0,0,0,1,1,1,0,0],(12,7)), + ([0,1,0,0,0,0,1,1,0,1],(12,8)), + ([0,1,0,0,0,0,0,1,0,1],(12,9)), + ([0,1,0,0,0,0,0,0,0,0,0],(12,10)), + ([0,0,1,0,1,1,1,1,0,0,0],(12,11)), + ([0,0,1,0,1,1,1,0,0,1,0],(12,12)), + ([0,0,1,0,1,1,0,1,1,0,0],(12,13)), + ([0,0,1,0,1,1,0,0,1,1,1],(12,14)), + ([0,0,0,0,0,1,0,0],(12,15)), + ([0,1,0,0,1,1,0,1,1,0,0],(13,0)), + ([0,1,0,0,1,0,1,1,0,0],(13,1)), + ([0,1,0,0,1,0,1,0,0,0],(13,2)), + ([0,1,0,0,1,0,0,1,1,0],(13,3)), + ([0,1,0,0,1,0,0,0,0,0],(13,4)), + ([0,1,0,0,0,1,1,0,1,0],(13,5)), + ([0,1,0,0,0,1,0,0,0,1],(13,6)), + ([0,1,0,0,0,0,1,0,1,0],(13,7)), + ([0,1,0,0,0,0,0,0,0,1,1],(13,8)), + ([0,0,1,0,1,1,1,1,1,0,0],(13,9)), + ([0,0,1,0,1,1,1,0,1,1,0],(13,10)), + ([0,0,1,0,1,1,1,0,0,0,1],(13,11)), + ([0,0,1,0,1,1,0,1,1,0,1],(13,12)), + ([0,0,1,0,1,1,0,1,0,0,1],(13,13)), + ([0,0,1,0,1,1,0,0,1,0,1],(13,14)), + ([0,0,0,0,0,0,1,0],(13,15)), + ([0,1,0,0,0,0,0,0,1,0,0,1],(14,0)), + ([0,1,0,0,0,1,1,0,0,0],(14,1)), + ([0,1,0,0,0,1,0,1,1,0],(14,2)), + ([0,1,0,0,0,1,0,0,1,0],(14,3)), + ([0,1,0,0,0,0,1,0,1,1],(14,4)), + ([0,1,0,0,0,0,1,0,0,0],(14,5)), + ([0,1,0,0,0,0,0,0,1,1],(14,6)), + ([0,0,1,0,1,1,1,1,1,1,0],(14,7)), + ([0,0,1,0,1,1,1,1,0,1,0],(14,8)), + ([0,0,1,0,1,1,1,0,1,0,0],(14,9)), + ([0,0,1,0,1,1,0,1,1,1,1],(14,10)), + ([0,0,1,0,1,1,0,1,0,1,1],(14,11)), + ([0,0,1,0,1,1,0,1,0,0,0],(14,12)), + ([0,0,1,0,1,1,0,0,1,1,0],(14,13)), + ([0,0,1,0,1,1,0,0,1,0,0],(14,14)), + ([0,0,0,0,0,0,0,0],(14,15)), + ([0,0,1,0,1,0,1,1],(15,0)), + ([0,0,1,0,1,0,0],(15,1)), + ([0,0,1,0,0,1,1],(15,2)), + ([0,0,1,0,0,0,1],(15,3)), + ([0,0,0,1,1,1,1],(15,4)), + ([0,0,0,1,1,0,1],(15,5)), + ([0,0,0,1,0,1,1],(15,6)), + ([0,0,0,1,0,0,1],(15,7)), + ([0,0,0,0,1,1,1],(15,8)), + ([0,0,0,0,1,1,0],(15,9)), + ([0,0,0,0,1,0,0],(15,10)), + ([0,0,0,0,0,1,1,1],(15,11)), + ([0,0,0,0,0,1,0,1],(15,12)), + ([0,0,0,0,0,0,1,1],(15,13)), + ([0,0,0,0,0,0,0,1],(15,14)), + ([0,0,1,1],(15,15))] + diff --git a/Codec/Audio/MP3/Types.hs b/Codec/Audio/MP3/Types.hs new file mode 100644 --- /dev/null +++ b/Codec/Audio/MP3/Types.hs @@ -0,0 +1,125 @@ +-- +-- This code is part of the Experimental Haskell MP3 Decoder, version 0.0.1. +-- Copyright (c) 2008 Bjorn Edstrom +-- +-- This software is provided 'as-is', without any express or implied +-- warranty. In no event will the authors be held liable for any damages +-- arising from the use of this software. +-- +-- Permission is granted to anyone to use this software for any purpose, +-- including commercial applications, and to alter it and redistribute it +-- freely, subject to the following restrictions: +-- +-- 1. The origin of this software must not be misrepresented; you must not +-- claim that you wrote the original software. If you use this software +-- in a product, an acknowledgment in the product documentation would be +-- appreciated but is not required. +-- +-- 2. Altered source versions must be plainly marked as such, and must not be +-- misrepresented as being the original software. +-- +-- 3. This notice may not be removed or altered from any source +-- distribution. +-- + +module Codec.Audio.MP3.Types where + +-- +-- Simple types. +-- +type Sample = Double +type Frequency = Double + +type SampleRate = Int + +data ChannelMode = Mono + | Stereo + | DualChannel + | JointStereo + deriving (Eq) + +instance Show ChannelMode where + show Mono = "Mono" + show Stereo = "Stereo" + show DualChannel = "DualChannel" + show JointStereo = "JointStereo" + +data BlockFlag = LongBlocks + | ShortBlocks + | MixedBlocks + deriving (Eq) + +instance Show BlockFlag where + show LongBlocks = "LongBlocks" + show ShortBlocks = "ShortBlocks" + show MixedBlocks = "MixedBlocks" + +-- +-- For decoding. +-- +data MP3FrameHeader = MP3FrameHeader { + headBitrate :: Int, + headSampleRate :: SampleRate, + headChannels :: ChannelMode, + -- details + headCRC :: Bool, + headPadding :: Int, + headStereoMS :: Bool, + headStereoIS :: Bool +} deriving (Show) + +-- Layer between MP3 and MP3Unpack +data MP3Data = MP3Data1Channels SampleRate ChannelMode (Bool, Bool) + MP3DataChunk MP3DataChunk + | MP3Data2Channels SampleRate ChannelMode (Bool, Bool) + MP3DataChunk MP3DataChunk + MP3DataChunk MP3DataChunk + deriving (Show) + +mp3dataChunk00 (MP3Data1Channels _ _ _ chunk _) = chunk +mp3dataChunk00 (MP3Data2Channels _ _ _ chunk _ _ _) = chunk + +mp3dataSampleRate (MP3Data1Channels sr _ _ _ _) = sr +mp3dataSampleRate (MP3Data2Channels sr _ _ _ _ _ _) = sr + +data MP3DataChunk = MP3DataChunk { + chunkBlockType :: !Int, + chunkBlockFlag :: !BlockFlag, + chunkScaleGain :: !Double, + chunkScaleSubGain :: !(Double, Double, Double), + chunkScaleLong :: ![Double], + chunkScaleShort :: ![[Double]], + chunkISParam :: !([Int], [[Int]]), + chunkData :: ![Int] +} deriving (Show) + + +-- Pretty print. + +prettyData (MP3Data1Channels sr ch (ms, is) c00 c10) = + show sr ++ "Hz" ++ + " " ++ printCh ch (ms, is) ++ + " Chunks: [" ++ printDC c00 ++ + "," ++ printDC c10 ++ "]" + +prettyData (MP3Data2Channels sr ch (ms, is) c00 c01 c10 c11) = + show sr ++ "Hz" ++ + " " ++ printCh ch (ms, is) ++ + " Chunks: [" ++ printDC c00 ++ + "," ++ printDC c01 ++ + "," ++ printDC c10 ++ + "," ++ printDC c11 ++ "]" + +printDC (MP3DataChunk bt bf _ _ _ _ _ _) = printBF bf ++ "(" ++ show bt ++ ")" + +printBF LongBlocks = "L" +printBF ShortBlocks = "S" +printBF MixedBlocks = "M" + +printCh JointStereo (True, True) = "JointStereo (MS, IS)" +printCh JointStereo (True, False) = "JointStereo (MS)" +printCh JointStereo (False, True) = "JointStereo (IS)" +printCh JointStereo _ = "JointStereo" +printCh ch _ = show ch + + diff --git a/Codec/Audio/MP3/Unpack.hs b/Codec/Audio/MP3/Unpack.hs new file mode 100644 --- /dev/null +++ b/Codec/Audio/MP3/Unpack.hs @@ -0,0 +1,893 @@ +-- +-- module Unpack - Unpacks an MP3 bitstream into parts. +-- +-- This code is part of the Experimental Haskell MP3 Decoder, version 0.0.1. +-- Copyright (c) 2008 Bjorn Edstrom +-- +-- This software is provided 'as-is', without any express or implied +-- warranty. In no event will the authors be held liable for any damages +-- arising from the use of this software. +-- +-- Permission is granted to anyone to use this software for any purpose, +-- including commercial applications, and to alter it and redistribute it +-- freely, subject to the following restrictions: +-- +-- 1. The origin of this software must not be misrepresented; you must not +-- claim that you wrote the original software. If you use this software +-- in a product, an acknowledgment in the product documentation would be +-- appreciated but is not required. +-- +-- 2. Altered source versions must be plainly marked as such, and must not be +-- misrepresented as being the original software. +-- +-- 3. This notice may not be removed or altered from any source +-- distribution. +-- +-- Small Warning: Unpacking the bitstream is the messiest part of +-- MP3-decoding, so this code is not the prettiest ever written. +-- +-- We unpack the bitstream in two steps. +-- +-- 1) The bytes in an MP3 are grouped in blocks known as frames. +-- A frame consists of a header, side data, and main data. +-- The header has some information about the properties of the +-- audio. The side data contains some information about how +-- the audio should be decoded, but most bits describe +-- how to unpack the main data. +-- +-- The main data within a frame do not necessarily +-- correspond to the header and side data. The first step is to +-- take the "physical" frames and group them into "logical +-- frames", consisting of one header, side data, and +-- bytes of main data. +-- +-- 2) We then take the logical frame and unpack the main data, +-- according to the parameters saved in the side data. +-- The main data consists of two "granules", containing one +-- or two channels each. Each of these channel granules are +-- later decoded (more or less) separately. +-- +-- Each channel granule consists of scale information, and +-- huffman coded audio. +-- + +module Codec.Audio.MP3.Unpack ( + mp3Seek + ,mp3Unpack + ,MP3Bitstream(..) +) where + + +-- binary-strict from Hackage. +import qualified Data.Binary.Strict.BitGet as BG +import Data.Binary.Strict.Get + +import qualified Data.ByteString as B +import Data.Word +import Data.Bits +import Control.Monad (replicateM) + +import Codec.Audio.MP3.Huffman +import Codec.Audio.MP3.Types +import Codec.Audio.MP3.Tables + +import Debug.Trace + +-- +-- Exported types. +-- + +data MP3Bitstream = MP3Bitstream { + bitstreamStream :: B.ByteString, + bitstreamBuffer :: [Word8] +} deriving (Show) + +-- +-- The types below are only used in this module during unpacking. +-- Important information needed elsewhere is copied to another +-- data structure described in Types.hs +-- + +data MP3LogicalFrame = MP3LogicalFrame { + logicalHeader :: MP3FrameHeader, + logicalSide :: MP3SideInfo, + logicalData :: [Word8] +} deriving (Show) + +data MP3HuffmanData = MP3HuffmanData { + huffmanBigValues :: Int, + huffmanRegionLengths :: (Int, Int, Int), + huffmanTable :: (Int, Int, Int), + huffmanCount1Table :: Int +} deriving (Show) + +data MP3ScaleData = MP3ScaleData { + scaleGlobalGain :: Double, + scaleLengths :: (Int, Int), + scaleSubblockGain :: (Double, Double, Double), + scaleScalefacScale :: Int, + scalePreflag :: Int +} deriving (Show) + +data MP3SideData = MP3SideData { + sideHuffman :: MP3HuffmanData, + sideScalefactor :: MP3ScaleData, + sidePart23Length :: Int, + sideBlocktype :: Int, + sideBlockflag :: BlockFlag +} deriving (Show) + +data MP3SideInfo = MP3SideInfo1Ch { sideMaindata :: Int, + sideScfsi :: Int, + sideGranule0ch0 :: MP3SideData, + sideGranule1ch0 :: MP3SideData } + | MP3SideInfo2Ch { sideMaindata :: Int, + sideScfsi :: Int, + sideGranule0ch0 :: MP3SideData, + sideGranule0ch1 :: MP3SideData, + sideGranule1ch0 :: MP3SideData, + sideGranule1ch1 :: MP3SideData } + deriving (Show) + + +-- +-- Generic utilities. +-- + +flattenTuple :: [(a, a)] -> [a] +flattenTuple [] = [] +flattenTuple ((x0,x1):xs) = x0 : x1 : flattenTuple xs + +applyTuple :: (a -> b) -> (c -> d) -> (a, c) -> (b, d) +applyTuple f1 f2 (x, y) = (f1 x, f2 y) + +toBool 0 = False +toBool _ = True + +padWith :: Int -> a -> [a] -> [a] +padWith n padding xs = xs ++ replicate (n - length xs) padding + +-- +-- Utilities for dealing with bits. +-- + +-- binery-strict is broken on some some setups so we use the safe but slow +-- method of constructing integers from individual bits. BG.getBit works. +getBitsFixed 0 = return 0 +getBitsFixed n = do bit0 <- BG.getBit >>= return . fromEnum + rest <- getBitsFixed (n-1) + return $ bit0 `shiftL` (n-1) .|. rest + + +toWord32 :: [Word8] -> Word32 +toWord32 (b0:b1:b2:b3:[]) = (fromIntegral b3) + + (fromIntegral b2) * 0x100 + + (fromIntegral b1) * 0x10000 + + (fromIntegral b0) * 0x1000000 +toWord32 _ = 0 + +bsGetWord32 :: B.ByteString -> Word32 +bsGetWord32 = toWord32 . B.unpack . (B.take 4) + +-- Extract an interval of bits from a larger integer. +-- bitInterval '11111111 11100000 00000000 00000000' 21 11 = '11111111 111' +bitInterval :: (Bits a) => a -> Int -> Int -> a +bitInterval word start size = (word `shiftR` start) .&. + ((1 `shiftL` size)-1) + + +-- +-- mp3ParseFrameHeader +-- +-- Get the important (needed for decoding) stuff out of a frame header. +-- +-- Return values: +-- +-- The function will return Nothing if the frame is malformed, +-- or if it's a valid header but a format not supported by this +-- decoder, such as MP2. +-- +-- Info: +-- +-- The first 11 bits of a correct header is the sync word, 0x7ff. +-- IS and MS are two stereo processing modes used to reduce +-- the size of a Joint Stereo MP3. Info in Decoder.hs. +-- +mp3ParseFrameHeader :: Word32 -> Maybe MP3FrameHeader +mp3ParseFrameHeader bits + | bitsSync /= 0x7ff = Nothing + | bitsMpeg /= 3 = Nothing -- We only support MPEG1 (bits=3) + | bitsLayer /= 1 = Nothing -- We only support Layer3 (bits=1) + | bitsBitrate == 0 || + bitsBitrate == 15 = Nothing + | bitsSR == 3 = Nothing + | otherwise = Just $ MP3FrameHeader bitrate samplerate + channels crc padding ms is + where + bitrate = [ 0, 32, 40, 48, 56, 64, + 80, 96, 112, 128, 160, 192, + 224, 256, 320, 0] !! (fromIntegral bitsBitrate) + samplerate = [44100, 48000, 32000] !! (fromIntegral bitsSR) + channels = [Stereo, JointStereo, + DualChannel, Mono] !! (fromIntegral bitsCh) + crc = [True, False] !! (fromIntegral bitsCRC) + padding = fromIntegral bitsPadding + (is, ms) = [(False, False), (True, False), + (False, True), (True, True)] !! (fromIntegral bitsMode) + bitsSync = bitInterval bits 21 11 + bitsMpeg = bitInterval bits 19 2 + bitsLayer = bitInterval bits 17 2 + bitsCRC = bitInterval bits 16 1 + bitsBitrate = bitInterval bits 12 4 + bitsSR = bitInterval bits 10 2 + bitsPadding = bitInterval bits 9 1 + bitsCh = bitInterval bits 6 2 + bitsMode = bitInterval bits 4 2 + --getbits = bitInterval bits + + +-- +-- mp3FrameLength +-- +-- How long a physical frame is, in bytes. +-- +-- This simplified expression takes the frame length, side info length +-- and main data into account. +-- +mp3FrameLength :: MP3FrameHeader -> Int +mp3FrameLength header = let br = headBitrate header + sr = headSampleRate header + padding = headPadding header + in (144 * 1000 * br) `div` sr + padding + + +-- +-- mp3ParseSideInfo +-- +-- Parse the (32 for stereo, 17 for mono) side data bytes. +-- +-- Return values: +-- +-- The function will return Nothing if +-- The input buffer is too short. +-- The input buffer is of the correct size, but contains invalid data. +-- The function will return a Just MP3SideInfo otherwise. +-- +-- Info: +-- +-- Many of the bits in the side info are indices to tables defined +-- in the MP3 standard, and are thus not interesting in themselves. +-- In this MP3 decoder, the design choice is to parse these bits +-- as early as possible. +-- +mp3ParseSideInfo :: MP3FrameHeader -> [Word8] -> Maybe MP3SideInfo +mp3ParseSideInfo header buffer = + case BG.runBitGet stream (if mono then getMono + else getStereo) of + Right ret -> ret + otherwise -> Nothing + where + stream = B.pack buffer + mono = Mono == headChannels header + samplerate = headSampleRate header + + getMono = do dataptr <- getBitsFixed 9 + private <- getBitsFixed 5 + scfsi <- getBitsFixed 4 + granule0ch0 <- bitSideData + granule1ch0 <- bitSideData + return $ constr (fromIntegral dataptr) + scfsi + granule0ch0 + granule1ch0 + where + constr dataptr scfsi (Just g00) (Just g01) = + Just $ MP3SideInfo1Ch dataptr scfsi g00 g01 + constr _ _ _ _ = Nothing + + getStereo = do dataptr <- getBitsFixed 9 + private <- getBitsFixed 3 + scfsi <- getBitsFixed 8 -- 4 bits per channel + granule0ch0 <- bitSideData + granule0ch1 <- bitSideData + granule1ch0 <- bitSideData + granule1ch1 <- bitSideData + return $ constr (fromIntegral dataptr) + scfsi + granule0ch0 + granule0ch1 + granule1ch0 + granule1ch1 + where + constr dataptr scfsi (Just g00) (Just g01) + (Just g10) (Just g11) = + Just $ MP3SideInfo2Ch dataptr scfsi g00 g01 g10 g11 + constr _ _ _ _ _ _ = Nothing + + validateTable n + | n == 4 || n == 14 = False + | otherwise = True + + toBlockflag mixedflag blocktype + | mixedflag == True = MixedBlocks + | mixedflag == False && blocktype == 2 = ShortBlocks + | otherwise = LongBlocks + + bitSideData = do + -- To parse side data (this): flag. + -- To parse main data: part23. + -- To parse main data (huffman): bigvalues, table0-2. + -- To parse main data (scales): scalelengths. + -- For decoding the audio in Decoder.hs: globalgain, + -- blocktype, blockflag subgain0-2. + part23 <- getBitsFixed 12 + bigvalues <- getBitsFixed 9 + globalgainb <- getBitsFixed 8 + let globalgain = mp3FloatRep1 globalgainb + scalelengths <- getBitsFixed 4 >>= return . (tableSlen !!) + flag <- BG.getBit + blocktype <- getBitsFixed (if flag then 2 else 0) + mixed <- getBitsFixed (if flag then 1 else 0) >>= + return . toEnum + let blockflag = toBlockflag mixed blocktype + table0 <- getBitsFixed 5 + table1 <- getBitsFixed 5 + table2 <- getBitsFixed (if flag then 0 else 5) + subgain0b <- getBitsFixed (if flag then 3 else 0) + subgain1b <- getBitsFixed (if flag then 3 else 0) + subgain2b <- getBitsFixed (if flag then 3 else 0) + let subgain0 = mp3FloatRep2 subgain0b + subgain1 = mp3FloatRep2 subgain1b + subgain2 = mp3FloatRep2 subgain2b + + -- To parse main data (huffman): r0len, r1len, r2len. + -- This computation is slightly involved. + regionabits <- getBitsFixed (if flag then 0 else 4) + regionbbits <- getBitsFixed (if flag then 0 else 3) + let racnt = if flag then (if blocktype == 2 then 8 else 7) + else regionabits + rbcnt = if flag then 20 - racnt + else regionbbits + sbTable = tableScaleBandBoundary samplerate + r1bound = sbTable $ racnt + 1 + r2bound = sbTable $ racnt + 1 + rbcnt + 1 + bv2 = bigvalues*2 + r0len = if blocktype == 2 + then min bv2 36 + else min bv2 r1bound + r1len = if blocktype == 2 + then min (bv2-r0len) 540 + else min (bv2-r0len) (r2bound - r0len) + r2len = if blocktype == 2 + then 0 + else bv2 - (r0len + r1len) + + -- To parse main data (huffman): count1table. + -- To parse the main data (scales): scalefacscale, preflag. + preflag <- BG.getBit >>= return . fromEnum + scalefacbit <- BG.getBit + let scalefacscale = if scalefacbit then 1 else 0 + count1table <- BG.getBit >>= return . fromEnum + + -- huffdata has data needed by the Huffman decoder. + -- scaledata has data needed for parsing the scale data, + -- and it also has a few parameters needed by the decoder + -- in Decoder.hs. + let huffdata = MP3HuffmanData bigvalues (r0len, r1len, r2len) + (table0, table1, table2) count1table + scaledata = MP3ScaleData globalgain scalelengths + (subgain0, subgain1, subgain2) + scalefacscale preflag + valid = if (validateTable table0) && + (validateTable table1) && + (if flag then True else validateTable table2) + then True else False + return $ if valid then Just (MP3SideData huffdata scaledata part23 + blocktype blockflag) + else Nothing + + +-- mp3PeekDataPtr takes an unparsed ByteString and returns the dataptr +-- (see mp3ParseSideInfo). +mp3PeekDataPtr :: B.ByteString -> Maybe Int +mp3PeekDataPtr bs = + case mp3ParseFrameHeader (toWord32 (B.unpack (B.take 4 bs))) of + Nothing -> Nothing + Just header -> let len = 4 + if headCRC header then 2 else 0 + in case BG.runBitGet (B.drop len bs) bitGetter of + Right ret -> Just ret + otherwise -> Nothing + where + bitGetter = do getBitsFixed 9 + +-- +-- Warning: This decoder treats some bits as floatings points. +-- The specification instead treats them as integers. Se discussion +-- at www.bjrn.se/mp3dec +-- +-- The side info has two floating point representations +-- +-- Representation 1 maps an 8 bit value to the range 0.0 - 2435.5. +-- +-- Representation 2 maps a 3 bit value to the range +-- [1, 0.25, 0.0625, 0.01563, 0.00391, 0.00098, 0.00024, 0.00006] +-- +mp3FloatRep1 :: Int -> Double +mp3FloatRep1 n = 2.0 ** (0.25 * (fromIntegral n - 210)) + +mp3FloatRep2 :: Int -> Double +mp3FloatRep2 n = 2.0 ** (0.25 * (fromIntegral (-n * 8))) + +-- +-- mp3DecodeHuffman +-- +-- Decodes the Huffman data to audio (in the frequency domain). +-- +-- The huffman coded bits are grouped in five regions, in +-- the 576 frequency bands: +-- +-- | region 0 | region 1 | region 2 | count1 region | zero | +-- +-- region0-2 are collectively known as the "big values" regions, as +-- the decoded bits are large (-8206 - 8206). These regions represent the +-- lower frequency bands. +-- +-- The count 1 region represent the higher frequencies, and can only take +-- on small values (-1 to 1). As the ear is insensitive in these +-- regions, not as much information is required to represent these +-- frequencies. +-- +-- The zero region are the frequencies so high they have been removed +-- by the encoder. These frequencies have magnitude 0. +-- +-- Different Huffman tables are used by the different regions for better +-- compression. (table1, table2, table3) correspond to the big values +-- regions, while tableC1 is for the count1 region. We call the three first +-- tables the "normal" tables. A normal table outputs two frequency samples. +-- We call the count1 table the quad table, as it outputs four frequency +-- samples. +-- +-- The normal tables are decoded as follows: +-- +-- 1) Consume input bits until we get a hit in the right Huffman tree. +-- We now have a tuple of two values (x,y), and also the linbits value +-- described further below. +-- 2) If x == 15, read linbits bits and add to x. This makes sure the +-- frequency sample can be large, if necessary. +-- 3) If x /= 0, get one bit. If this bit is one, x is negative, otherwise +-- positive. +-- 4) Do step 2 and 3 for y. +-- +-- The quad table is decoded as follows: +-- +-- 1) Consume input bits until we get a hit in the right Huffman tree. +-- We now have a 4-tuple (x,w,x,y). +-- 2) If v /= 0, get one bit. If this bit is one, v is negative, otherwise +-- positive. +-- 3) Do step 2 for w, x, y. +-- +-- The length, in number of output samples, for region0-2 is r0len to +-- r2len respectively. +-- The length, in number of output samples, for the quad region is not +-- known explicitly, but is calculated from bitlength of the main data +-- and the number of bits read when decoding the big values regions. +-- +-- TODO: +-- +-- This code can be optimized significantly, without hurting readability +-- too much. Instead of walking the tree, consuming one bit at a time +-- until we find a hit in the tree, a large lookup table can be used. +-- Consider a Huffman tree where the longest code word is N bits. We +-- create a lookup table of 2^N elements, where all code words shorter +-- than N bits are padded with all bitstrings until they are of length +-- N. To use the table, we peek N bits in the bitstream, and use these +-- bits as an index to the lookup table. There we find the length of the +-- code word (so we can throw away the correct number of bits), and the +-- value. +-- +-- Say we have the following Huffman table: +-- +-- code word value +-- 0 a +-- 10 b +-- 111 c +-- +-- The corresponding lookup-table will look like this: +-- +-- table[000] = (a, 1) +-- table[001] = (a, 1) +-- table[010] = (a, 1) +-- table[011] = (a, 1) +-- table[100] = (b, 2) +-- table[101] = (b, 2) +-- table[110] = Null +-- table[111] = (c, 3) +-- +-- To use the table, we peek 3 bits, checks the table. If the result is +-- (b, 2), we throw away 2 bits, and start over. +-- +-- For tables where the longest code word is large, real world +-- decoders use a technique where the lookup table contains "pointers" +-- to other parts of the table, to handle the rare cases where the +-- code words are very long. +-- + +--mp3DecodeHuffman huffdata part23len part2len = +mp3DecodeHuffman huffdata huffbitlength = + do (reg0, bitcount0) <- decodeRegion r0len table1 + (reg1, bitcount1) <- decodeRegion r1len table2 + (reg2, bitcount2) <- decodeRegion r2len table3 + let bitsread = bitcount0 + bitcount1 + bitcount2 + rqlen = huffbitlength - bitsread - 1 + regQ <- decodeRegionQ tableC1 rqlen [] + return $ reg0 ++ reg1 ++ reg2 ++ regQ + where + (r0len, r1len, r2len) = huffmanRegionLengths huffdata + (table1, table2, table3) = huffmanTable huffdata + tableC1 = huffmanCount1Table huffdata + + -- We divide reglen by 2 as each normal Huffman tree has 2 output + -- samples. The stuff after >>= takes the list of + -- ((sample0,sample1),bitsread) and constructs a new list + -- [sample0,sample1,...] as well as a sum of the bits read. + decodeRegion reglen tablen = + replicateM (reglen `div` 2) (decodeOne tablen) + >>= return . (applyTuple flattenTuple sum) . unzip + + signBits x = if x > 0 then 1 else 0 + linBits x linbits = if x == 15 && linbits > 0 then linbits else 0 + + decodeOne 0 = return $ ((0, 0), 0) + decodeOne tablen = + do let (table, linbits) = huffmanDecodeTable tablen + mval <- huffmanLookupM BG.getBit table + case mval of + Nothing -> error "mp3DecodeHuffman" + Just ((x, y), bitn) -> do + let bxlin = linBits x linbits + bylin = linBits y linbits + bxsgn = signBits x + bysgn = signBits y + xlin <- getBitsFixed bxlin + xsgn <- getBitsFixed bxsgn >>= return . signMul + ylin <- getBitsFixed bylin + ysgn <- getBitsFixed bysgn >>= return . signMul + let x' = (x + xlin) * xsgn + y' = (y + ylin) * ysgn + bitn2 = bxlin + bylin + bxsgn + bysgn + return $ ((x', y'), bitn+bitn2) + + signMul 1 = (-1) + signMul 0 = 1 + + decodeOneQuad tablen = + do let table = huffmanDecodeTableQuad tablen + mval <- huffmanLookupM BG.getBit table + case mval of + Nothing -> return ((0,0,0,0),0) + Just ((v, w, x, y), bitn) -> do + vsgn <- getBitsFixed (signBits v) >>= return . signMul + wsgn <- getBitsFixed (signBits w) >>= return . signMul + xsgn <- getBitsFixed (signBits x) >>= return . signMul + ysgn <- getBitsFixed (signBits y) >>= return . signMul + let v' = v * vsgn + w' = w * wsgn + x' = x * xsgn + y' = y * ysgn + bitn2 = (signBits v) + (signBits w) + + (signBits x) + (signBits y) + return $ ((v', w', x', y'), bitn+bitn2) + + decodeRegionQ tablen bitsrem accum + | bitsrem <= 0 = if bitsrem == -1 + then do return $ accum + -- Some old encoders give incorrect length of + -- the quad region. Most decoders handle this, + -- but we won't (as of 0.0.1). + else error "Malformed MP3, aborting. See Unpack.hs" + | otherwise = + do ((v,w,x,y), bitn) <- decodeOneQuad tablen + r <- decodeRegionQ tablen (bitsrem - bitn) + (accum ++ [v,w,x,y]) + return $ r + + +-- Get regular huffman table from index. This function is safe, since +-- mp3ParseSideInfo ensures the table index is valid. +huffmanDecodeTable :: Int -> (HuffmanTree (Int, Int), Int) +huffmanDecodeTable n = (huffmanFromList table, linbits) + where + (table, linbits) = tableHuffman !! n + +-- Get quad huffman table from index. This function is safe, as the +-- input is only 1 bit and can only take two values. +huffmanDecodeTableQuad :: Int -> HuffmanTree (Int, Int, Int, Int) +huffmanDecodeTableQuad 0 = huffmanFromList (tableHuffmanQuad !! 0) +huffmanDecodeTableQuad 1 = huffmanFromList (tableHuffmanQuad !! 1) + +-- +-- mp3ParseRawScalefactors +-- +-- More information about the scale factors can be found in Decoder.hs. +-- Here a short description is sufficient: This function takes +-- bits as input and outputs two list of integers. These integers +-- are often parsed from the bits. Sometimes they are copied from a +-- previously parsed list, if the encoder notices regions of lists +-- are identical. +-- +-- We have to count the number of bits read to successfully decode +-- the Huffman data. +-- +mp3ParseRawScalefactors blocktype blockflag preflag slen1 slen2 scfsi gran0 + | blocktype == 2 && blockflag == MixedBlocks = + do scaleL0 <- replicateM 8 (getBitsFixed slen1) + scaleS0 <- replicateM 3 (replicateM 3 (getBitsFixed slen1)) + scaleS1 <- replicateM 7 (replicateM 3 (getBitsFixed slen2)) + let bitsread = 8*slen1 + 3*3*slen1 + 7*3*slen2 + scaleS = [[0,0,0],[0,0,0],[0,0,0]]++scaleS0++scaleS1 + return $ (padWith 22 0 scaleL0, + padWith 22 [0,0,0] scaleS, bitsread) + | blocktype == 2 = + do scaleS0 <- replicateM 6 (replicateM 3 (getBitsFixed slen1)) + scaleS1 <- replicateM 6 (replicateM 3 (getBitsFixed slen2)) + let bitsread = 6*3*slen1 + 6*3*slen2 + return $ ([], padWith 22 [0,0,0] (scaleS0++scaleS1), bitsread) + | otherwise = + do band0 <- if copyband0 then return $ take 6 gran0 + else replicateM 6 (getBitsFixed slen1) + band1 <- if copyband1 then return $ take 5 (drop 6 gran0) + else replicateM 5 (getBitsFixed slen1) + band2 <- if copyband2 then return $ take 5 (drop 11 gran0) + else replicateM 5 (getBitsFixed slen2) + band3 <- if copyband3 then return $ take 5 (drop 16 gran0) + else replicateM 5 (getBitsFixed slen2) + let bitsread = 6*(if copyband0 then 0 else slen1) + + 5*(if copyband1 then 0 else slen1) + + 5*(if copyband2 then 0 else slen2) + + 5*(if copyband3 then 0 else slen2) + scalefac = band0++band1++band2++band3++[0] --Padding + return $ (scalefac,[[]],bitsread) + where + + copyband0 = not (null gran0) && toBool (scfsi .&. 8) + copyband1 = not (null gran0) && toBool (scfsi .&. 4) + copyband2 = not (null gran0) && toBool (scfsi .&. 2) + copyband3 = not (null gran0) && toBool (scfsi .&. 1) + + +-- Above parses the scale factors to bits. This functions takes the bits +-- and converts them to doubles according to the correct floating point +-- representation. (See discussion at mp3FloatRep1 above). +-- +-- Preflag is simply a predefined table that may be set to give the +-- higher scale factors a larger range than 4 bits. +mp3UnpackScaleFactors large small preflag scalefacbit = + let large' = if preflag == 0 then large + else zipWith (+) large tablePretab + large'' = map floatFunc large' + small' = map (map floatFunc) small + in (large'', small') + where + floatFunc = mp3FloatRep3 scalefacbit + +-- Two different floating point representations can be used for the scale +-- factors. (See discussion at mp3FloatRep1). +mp3FloatRep3 :: Int -> Int -> Double +mp3FloatRep3 0 n = 2.0 ** ((-0.5) * (fromIntegral n)) +mp3FloatRep3 1 n = 2.0 ** ((-1) * (fromIntegral n)) + + +-- +-- mp3ParseMainData +-- +-- For stereo, the main data is grouped as follows: +-- +-- scale, granule 0 channel 0 +-- huffman, granule 0 channel 0 +-- scale, granule 0 channel 1 +-- huffman, granule 0 channel 1 +-- scale, granule 1 channel 0 +-- huffman, granule 1 channel 0 +-- scale, granule 1 channel 1 +-- huffman, granule 1 channel 1 +-- +-- For mono, the main data is grouped as follows. +-- +-- scale, granule 0 channel 0 +-- huffman, granule 0 channel 0 +-- scale, granule 1 channel 0 +-- huffman, granule 1 channel 0 +-- +-- scale is parsed by mp3ParseRawScaleFactors +-- huffman is parsed by mp3DecodeHuffman +-- +-- Return values: +-- +-- If the logical frame is too short or invalid, the function returns Nothing. +-- Otherwise it returns Just MP3Data. +-- + +mp3ParseMainData :: MP3LogicalFrame -> Maybe MP3Data +mp3ParseMainData (MP3LogicalFrame header side maindata) = parse + where + parse = + case BG.runBitGet (B.pack maindata) + (if mono then doAllMono else doAllStereo) of + Right ret -> Just ret + Left err -> Nothing + + mono = Mono == headChannels header + scfsi = sideScfsi side + scfsi0 = scfsi `shiftR` 4 + scfsi1 = scfsi .&. 0xf + + doOne (MP3SideData huffdata scaledata part23 bt bf) scfsi gran0 = + do let (slen1, slen2) = scaleLengths scaledata + pre = scalePreflag scaledata + scalefacbit = scaleScalefacScale scaledata + + (scaleL, scaleS, bitsread) <- + mp3ParseRawScalefactors bt bf pre slen1 slen2 scfsi gran0 + + let (scaleFacLarge, scaleFacSmall) = + mp3UnpackScaleFactors scaleL scaleS pre scalefacbit + -- Parameters to the IS Stereo decoder are saved in the + -- higher unused scale factors. + (isLarge, isSmall) = (scaleL, scaleS) + + maindata <- mp3DecodeHuffman huffdata (part23-bitsread) + + return $ (scaleL,MP3DataChunk bt bf + (scaleGlobalGain scaledata) + (scaleSubblockGain scaledata) + scaleFacLarge + scaleFacSmall + (isLarge, isSmall) + maindata) + + doAllMono = do (s0s, s0m) <- doOne (sideGranule0ch0 side) scfsi [] + (s1s, s1m) <- doOne (sideGranule1ch0 side) scfsi s0s + return $ MP3Data1Channels (headSampleRate header) + (headChannels header) + ((headStereoMS header, + headStereoIS header)) + s0m s1m + + doAllStereo = + do (s00s, s00m) <- doOne (sideGranule0ch0 side) scfsi0 [] + (s01s, s01m) <- doOne (sideGranule0ch1 side) scfsi1 [] + (s10s, s10m) <- doOne (sideGranule1ch0 side) scfsi0 s00s + (s11s, s11m) <- doOne (sideGranule1ch1 side) scfsi1 s01s + return $ MP3Data2Channels (headSampleRate header) + (headChannels header) + ((headStereoMS header, + headStereoIS header)) + s00m s01m s10m s11m + +-- +-- mp3Seek +-- +-- Throw away bytes in the bitstream until the first byte is a frame +-- header. This should be used to initialize the decoder before +-- calling mp3Unpack, and to reset the decoder whenever mp3Unpack +-- has found a broken frame. +-- +-- Return value: +-- +-- If the the bitstream is empty, or not an MP3, or really broken, +-- the function returns Nothing +-- If the bitstream is healthy, it returns a new bitstream that can +-- be used by mp3Unpack. +-- +mp3Seek :: MP3Bitstream -> Maybe MP3Bitstream +mp3Seek (MP3Bitstream bs _) = helper bs 8192 + where + helper bs 0 = Nothing -- Nothing interesting in 8 KB = broken. + helper bs read = + case (mp3ParseFrameHeader . bsGetWord32) bs of + Just header -> Just $ MP3Bitstream bs [] + otherwise -> helper (B.drop 1 bs) (read - 1) + +-- +-- mp3UnpackFrame +-- +-- Read a physical frame, and maybe return a logical frame. +-- +-- A logical frame consists of a header, side data, and main data, where +-- the main data contains the scale factors and huffman data for the granules +-- as explained in mp3ParseMainData. +-- +-- A physical frame looks like this: [H][C][S][data] +-- Where H is the 4 byte header, C is an optional 2 byte CRC +-- we ignore, S is the 17 (mono) or 32 (stereo) side informataion, +-- and data is a kind of buffer, that may or may not contain parts +-- of the main data we need to construct a logical frame. +-- +-- In "data" in the current frame, and possibly preceding frames, are +-- the main data bits that correspond to the header/sideinfo, containing +-- the scale factors and huffman coded audio. It may look like this, +-- +-- [...][data1][data2][data3][hcs1][data3][hcs2][data3][data4][hcs3][...] +-- Where hcs1 is [H1][C1][S1]. +-- +-- In this example, these are physical frames: +-- +-- [hcs1][data3] +-- [hcs2][data3][data4] +-- [hcs3][...] (until hcs4, not shown) +-- +-- And these are the logical frames: +-- +-- [hcs1][data1] +-- [hcs2][data2] +-- [hcs3][data3][data3][data3] +-- +-- In the side information for a physical frame is a value known as the +-- dataptr (in the MP3 specification, this is known under a different name +-- but this name is very confusing so It's not mentioned here). +-- If we are currently reading physical frame n, then the dataptr in physical +-- frame n+1 tells us when we have enough main data. +-- +-- In the MP3Bitstream we maintain state what we've read so far. When we're +-- at the physical frame [hcs1][data3], the buffer contains +-- [data1][data2][data3] +-- We peek at the side data in [hcs2] to find out where data1 ends, +-- copies it to the logical frame, and deletes data1 from the buffer. +-- Note that the dataptr value in [hcs2] is a negative offset from the end +-- of the buffer, not the length of data1 itself. +-- +mp3UnpackFrame :: MP3Bitstream -> (MP3Bitstream, Maybe MP3LogicalFrame) +mp3UnpackFrame (MP3Bitstream bs buffer) = + case (mp3ParseFrameHeader . bsGetWord32) bs of + Just header -> unpack1 header + otherwise -> error "Unsupported or broken header." + where + unpack1 header = + case runGet byteGetter bs of + (Right (side, buffer', dataptr), remaining) -> + unpack2 header side buffer' dataptr remaining + (otherwise, remaining) -> + (MP3Bitstream remaining [], Nothing) + where + byteGetter = do + let lengthcrc = if headCRC header then 2 else 0 + lengthside = if Mono == headChannels header then 17 else 32 + lengthframe = mp3FrameLength header + head_ <- getByteString 4 + crc_ <- getByteString lengthcrc + side <- getByteString lengthside + main <- getByteString (lengthframe - 4 - lengthcrc - lengthside) + peek <- lookAhead $ getByteString 8 + let buffer' = buffer ++ B.unpack main + lbuffer' = length buffer' + return $ (mp3ParseSideInfo header (B.unpack side), + buffer', + mp3PeekDataPtr peek) + + unpack2 header (Just sidedata) newbuf (Just dataptr) bs' = + let lnewbuf = length newbuf + (logicalbuf, buf') = splitAt (lnewbuf - dataptr) newbuf + -- If the state buffer is empty, the current logical frame is + -- broken (main data that should precede the frame is missing.) + logical = if buffer == [] + then Nothing + else Just $ MP3LogicalFrame header sidedata logicalbuf + in (MP3Bitstream bs' buf', logical) + unpack2 _ _ _ _ rem = (MP3Bitstream rem [], Nothing) + +-- +-- mp3Unpack +-- +-- A helper function that takes a bitstream, unpacks it into a logical +-- frame, then parses the main data to return an MP3Data, used by the +-- decoder. +-- +mp3Unpack :: MP3Bitstream -> (MP3Bitstream, Maybe MP3Data) +mp3Unpack bitstream = helper (mp3UnpackFrame bitstream) + where + helper (bitstream', Nothing) = (bitstream', Nothing) + helper (bitstream', Just logical) = + case mp3ParseMainData logical of + Just mdata -> (bitstream', Just mdata) + otherwise -> (bitstream', Nothing) + diff --git a/Codec/Audio/MP3/c_imdct.c b/Codec/Audio/MP3/c_imdct.c new file mode 100644 --- /dev/null +++ b/Codec/Audio/MP3/c_imdct.c @@ -0,0 +1,77 @@ +/* + * imdct.c - naive IDMCT implementation. This can be made O(n log n), + * but as is the rest of the decoder is too slow for this to matter + * we ignore it. + * + * This code is part of the Experimental Haskell MP3 Decoder, version 0.0.1. + * Copyright (c) 2008 Bjorn Edstrom + * + * This software is provided 'as-is', without any express or implied + * warranty. In no event will the authors be held liable for any damages + * arising from the use of this software. + * + * Permission is granted to anyone to use this software for any purpose, + * including commercial applications, and to alter it and redistribute it + * freely, subject to the following restrictions: + * + * 1. The origin of this software must not be misrepresented; you must not + * claim that you wrote the original software. If you use this software + * in a product, an acknowledgment in the product documentation would be + * appreciated but is not required. + * + * 2. Altered source versions must be plainly marked as such, and must not be + * misrepresented as being the original software. + * + * 3. This notice may not be removed or altered from any source + * distribution. + */ + +#include + +#define PI 3.1415926535897931 + +void imdct18(double *in, double *out) +{ + int k, n; + double sum; + static double lookup[36][18]; + static int lookup_init = 0; + + if (lookup_init == 0) { + + for (n = 0; n < 36; n++) + for (k = 0; k < 18; k++) + lookup[n][k] = cos((PI/18) * (n + 0.5 + 18/2.0) * (k + 0.5)); + + lookup_init = 1; + } + + for (n = 0; n < 36; n++) { + sum = 0.0; + for (k = 0; k < 18; k+=3) { + sum += in[k+0] * lookup[n][k+0]; + sum += in[k+1] * lookup[n][k+1]; + sum += in[k+2] * lookup[n][k+2]; + } + out[n] = sum; + } +} + +void imdct(int points, double *in, double *out) +{ + int k, n; + double sum; + + if (points == 18) { + imdct18(in, out); + return; + } + + for (n = 0; n < points*2; n++) { + sum = 0.0; + for (k = 0; k < points; k++) + sum += in[k] * cos((PI/points) * (n + 0.5 + points/2.0) * (k + 0.5)); + out[n] = sum; + } +} + diff --git a/Codec/Audio/MP3/c_imdct.h b/Codec/Audio/MP3/c_imdct.h new file mode 100644 --- /dev/null +++ b/Codec/Audio/MP3/c_imdct.h @@ -0,0 +1,15 @@ +#ifndef IMDCT_H +#define IMDCT_H 1 + +#ifdef __cplusplus +extern "C" { +#endif + +void imdct(int points, double *in, double *out); + +#ifdef __cplusplus +} +#endif + +#endif + diff --git a/Codec/Audio/MP3/c_synth.c b/Codec/Audio/MP3/c_synth.c new file mode 100644 --- /dev/null +++ b/Codec/Audio/MP3/c_synth.c @@ -0,0 +1,198 @@ +/* + * synth.c - The MPEG1 filter bank, algorithm straight from the + * specification. + * + * This code is part of the Experimental Haskell MP3 Decoder, version 0.0.1. + * Copyright (c) 2008 Bjorn Edstrom + * + */ + +#include + +#define PI 3.1415926535897931 + +static double synth_window[512] = { + 0.000000000, -0.000015259, -0.000015259, -0.000015259, + -0.000015259, -0.000015259, -0.000015259, -0.000030518, + -0.000030518, -0.000030518, -0.000030518, -0.000045776, + -0.000045776, -0.000061035, -0.000061035, -0.000076294, + -0.000076294, -0.000091553, -0.000106812, -0.000106812, + -0.000122070, -0.000137329, -0.000152588, -0.000167847, + -0.000198364, -0.000213623, -0.000244141, -0.000259399, + -0.000289917, -0.000320435, -0.000366211, -0.000396729, + -0.000442505, -0.000473022, -0.000534058, -0.000579834, + -0.000625610, -0.000686646, -0.000747681, -0.000808716, + -0.000885010, -0.000961304, -0.001037598, -0.001113892, + -0.001205444, -0.001296997, -0.001388550, -0.001480103, + -0.001586914, -0.001693726, -0.001785278, -0.001907349, + -0.002014160, -0.002120972, -0.002243042, -0.002349854, + -0.002456665, -0.002578735, -0.002685547, -0.002792358, + -0.002899170, -0.002990723, -0.003082275, -0.003173828, + 0.003250122, 0.003326416, 0.003387451, 0.003433228, + 0.003463745, 0.003479004, 0.003479004, 0.003463745, + 0.003417969, 0.003372192, 0.003280640, 0.003173828, + 0.003051758, 0.002883911, 0.002700806, 0.002487183, + 0.002227783, 0.001937866, 0.001617432, 0.001266479, + 0.000869751, 0.000442505, -0.000030518, -0.000549316, + -0.001098633, -0.001693726, -0.002334595, -0.003005981, + -0.003723145, -0.004486084, -0.005294800, -0.006118774, + -0.007003784, -0.007919312, -0.008865356, -0.009841919, + -0.010848999, -0.011886597, -0.012939453, -0.014022827, + -0.015121460, -0.016235352, -0.017349243, -0.018463135, + -0.019577026, -0.020690918, -0.021789551, -0.022857666, + -0.023910522, -0.024932861, -0.025909424, -0.026840210, + -0.027725220, -0.028533936, -0.029281616, -0.029937744, + -0.030532837, -0.031005859, -0.031387329, -0.031661987, + -0.031814575, -0.031845093, -0.031738281, -0.031478882, + 0.031082153, 0.030517578, 0.029785156, 0.028884888, + 0.027801514, 0.026535034, 0.025085449, 0.023422241, + 0.021575928, 0.019531250, 0.017257690, 0.014801025, + 0.012115479, 0.009231567, 0.006134033, 0.002822876, + -0.000686646, -0.004394531, -0.008316040, -0.012420654, + -0.016708374, -0.021179199, -0.025817871, -0.030609131, + -0.035552979, -0.040634155, -0.045837402, -0.051132202, + -0.056533813, -0.061996460, -0.067520142, -0.073059082, + -0.078628540, -0.084182739, -0.089706421, -0.095169067, + -0.100540161, -0.105819702, -0.110946655, -0.115921021, + -0.120697021, -0.125259399, -0.129562378, -0.133590698, + -0.137298584, -0.140670776, -0.143676758, -0.146255493, + -0.148422241, -0.150115967, -0.151306152, -0.151962280, + -0.152069092, -0.151596069, -0.150497437, -0.148773193, + -0.146362305, -0.143264771, -0.139450073, -0.134887695, + -0.129577637, -0.123474121, -0.116577148, -0.108856201, + 0.100311279, 0.090927124, 0.080688477, 0.069595337, + 0.057617188, 0.044784546, 0.031082153, 0.016510010, + 0.001068115, -0.015228271, -0.032379150, -0.050354004, + -0.069168091, -0.088775635, -0.109161377, -0.130310059, + -0.152206421, -0.174789429, -0.198059082, -0.221984863, + -0.246505737, -0.271591187, -0.297210693, -0.323318481, + -0.349868774, -0.376800537, -0.404083252, -0.431655884, + -0.459472656, -0.487472534, -0.515609741, -0.543823242, + -0.572036743, -0.600219727, -0.628295898, -0.656219482, + -0.683914185, -0.711318970, -0.738372803, -0.765029907, + -0.791213989, -0.816864014, -0.841949463, -0.866363525, + -0.890090942, -0.913055420, -0.935195923, -0.956481934, + -0.976852417, -0.996246338, -1.014617920, -1.031936646, + -1.048156738, -1.063217163, -1.077117920, -1.089782715, + -1.101211548, -1.111373901, -1.120223999, -1.127746582, + -1.133926392, -1.138763428, -1.142211914, -1.144287109, + 1.144989014, 1.144287109, 1.142211914, 1.138763428, + 1.133926392, 1.127746582, 1.120223999, 1.111373901, + 1.101211548, 1.089782715, 1.077117920, 1.063217163, + 1.048156738, 1.031936646, 1.014617920, 0.996246338, + 0.976852417, 0.956481934, 0.935195923, 0.913055420, + 0.890090942, 0.866363525, 0.841949463, 0.816864014, + 0.791213989, 0.765029907, 0.738372803, 0.711318970, + 0.683914185, 0.656219482, 0.628295898, 0.600219727, + 0.572036743, 0.543823242, 0.515609741, 0.487472534, + 0.459472656, 0.431655884, 0.404083252, 0.376800537, + 0.349868774, 0.323318481, 0.297210693, 0.271591187, + 0.246505737, 0.221984863, 0.198059082, 0.174789429, + 0.152206421, 0.130310059, 0.109161377, 0.088775635, + 0.069168091, 0.050354004, 0.032379150, 0.015228271, + -0.001068115, -0.016510010, -0.031082153, -0.044784546, + -0.057617188, -0.069595337, -0.080688477, -0.090927124, + 0.100311279, 0.108856201, 0.116577148, 0.123474121, + 0.129577637, 0.134887695, 0.139450073, 0.143264771, + 0.146362305, 0.148773193, 0.150497437, 0.151596069, + 0.152069092, 0.151962280, 0.151306152, 0.150115967, + 0.148422241, 0.146255493, 0.143676758, 0.140670776, + 0.137298584, 0.133590698, 0.129562378, 0.125259399, + 0.120697021, 0.115921021, 0.110946655, 0.105819702, + 0.100540161, 0.095169067, 0.089706421, 0.084182739, + 0.078628540, 0.073059082, 0.067520142, 0.061996460, + 0.056533813, 0.051132202, 0.045837402, 0.040634155, + 0.035552979, 0.030609131, 0.025817871, 0.021179199, + 0.016708374, 0.012420654, 0.008316040, 0.004394531, + 0.000686646, -0.002822876, -0.006134033, -0.009231567, + -0.012115479, -0.014801025, -0.017257690, -0.019531250, + -0.021575928, -0.023422241, -0.025085449, -0.026535034, + -0.027801514, -0.028884888, -0.029785156, -0.030517578, + 0.031082153, 0.031478882, 0.031738281, 0.031845093, + 0.031814575, 0.031661987, 0.031387329, 0.031005859, + 0.030532837, 0.029937744, 0.029281616, 0.028533936, + 0.027725220, 0.026840210, 0.025909424, 0.024932861, + 0.023910522, 0.022857666, 0.021789551, 0.020690918, + 0.019577026, 0.018463135, 0.017349243, 0.016235352, + 0.015121460, 0.014022827, 0.012939453, 0.011886597, + 0.010848999, 0.009841919, 0.008865356, 0.007919312, + 0.007003784, 0.006118774, 0.005294800, 0.004486084, + 0.003723145, 0.003005981, 0.002334595, 0.001693726, + 0.001098633, 0.000549316, 0.000030518, -0.000442505, + -0.000869751, -0.001266479, -0.001617432, -0.001937866, + -0.002227783, -0.002487183, -0.002700806, -0.002883911, + -0.003051758, -0.003173828, -0.003280640, -0.003372192, + -0.003417969, -0.003463745, -0.003479004, -0.003479004, + -0.003463745, -0.003433228, -0.003387451, -0.003326416, + 0.003250122, 0.003173828, 0.003082275, 0.002990723, + 0.002899170, 0.002792358, 0.002685547, 0.002578735, + 0.002456665, 0.002349854, 0.002243042, 0.002120972, + 0.002014160, 0.001907349, 0.001785278, 0.001693726, + 0.001586914, 0.001480103, 0.001388550, 0.001296997, + 0.001205444, 0.001113892, 0.001037598, 0.000961304, + 0.000885010, 0.000808716, 0.000747681, 0.000686646, + 0.000625610, 0.000579834, 0.000534058, 0.000473022, + 0.000442505, 0.000396729, 0.000366211, 0.000320435, + 0.000289917, 0.000259399, 0.000244141, 0.000213623, + 0.000198364, 0.000167847, 0.000152588, 0.000137329, + 0.000122070, 0.000106812, 0.000106812, 0.000091553, + 0.000076294, 0.000076294, 0.000061035, 0.000061035, + 0.000045776, 0.000045776, 0.000030518, 0.000030518, + 0.000030518, 0.000030518, 0.000015259, 0.000015259, + 0.000015259, 0.000015259, 0.000015259, 0.000015259, +}; + +void synth(double state[1024], double samples[576], + double newstate[1024], double output[576]) +{ + int s, i, j; + double S[32], U[512], sum; + static double lookup[64][32]; + static int lookup_init = 0; + + if (lookup_init == 0) { + for (i = 0; i < 64; i++) + for (j = 0; j < 32; j++) + lookup[i][j] = cos((16.0 + i) * (2.0*j + 1) * (PI/64.0)); + lookup_init = 1; + } + + for (i = 0; i < 1024; i++) + newstate[i] = state[i]; + + for (s = 0; s < 18; s++) { + for (i = 0; i < 32; i++) + S[i] = samples[i*18 + s]; + + /* V.. */ + for (i = 1023; i > 63; i--) + newstate[i] = newstate[i - 64]; + + for (i = 0; i < 64; i++) { + sum = 0.0; + for (j = 0; j < 32; j++) + sum += S[j] * lookup[i][j]; + newstate[i] = sum; + } + + for (i = 0; i < 8; i++) { + for (j = 0; j < 32; j++) { + U[i*64 + j] = newstate[i*128 + j]; + U[i*64 + j + 32] = newstate[i*128 + j + 96]; + } + } + + for (i = 0; i < 512; i++) + U[i] *= synth_window[i]; + + for (i = 0; i < 32; i++) { + sum = 0.0; + for (j = 0; j < 16; j++) + sum += U[j*32 + i]; + output[32*s + i] = sum; + } + } + + return; +} + diff --git a/Codec/Audio/MP3/c_synth.h b/Codec/Audio/MP3/c_synth.h new file mode 100644 --- /dev/null +++ b/Codec/Audio/MP3/c_synth.h @@ -0,0 +1,17 @@ + +#ifndef MP3SYNTH_H +#define MP3SYNTH_H 1 + +#ifdef __cplusplus +extern "C" { +#endif + +void synth(double state[1024], double samples[576], + double newstate[1024], double output[576]); + +#ifdef __cplusplus +} +#endif + +#endif + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,22 @@ + +Copyright (c) 2008 Bjorn Edstrom + +This software is provided 'as-is', without any express or implied +warranty. In no event will the authors be held liable for any damages +arising from the use of this software. + +Permission is granted to anyone to use this software for any purpose, +including commercial applications, and to alter it and redistribute it +freely, subject to the following restrictions: + + 1. The origin of this software must not be misrepresented; you must not + claim that you wrote the original software. If you use this software + in a product, an acknowledgment in the product documentation would be + appreciated but is not required. + + 2. Altered source versions must be plainly marked as such, and must not be + misrepresented as being the original software. + + 3. This notice may not be removed or altered from any source + distribution. + diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,59 @@ + +=== Prereq. === + +Using this code requires: + +*) A Haskell compiler, such as GHC. + +*) binary-strict, from here: + http://hackage.haskell.org/cgi-bin/hackage-scripts/package/binary-strict + If you've never used Haskell before, install binary-strict by + downloading and unpacking the source, cd to the directory where the + Setup file is, and do + + $ runhaskell Setup.lhs configure + $ runhaskell Setup.lhs build + $ runhaskell Setup.lhs install + +That's it. + + + +=== Building the decoder === + +Building the decoder works almost the same as building binary-strict. +From the directory where this file is, do: + +$ runhaskell Setup.lhs configure +$ runhaskell Setup.lhs build + +Do not install it (if you're familiar with Haskell and for some reason +want to install this decoder as a library, you'll have to edit the +cabal file). + +When done, there will be an executable file in dist/build/mp3driver. +Pass an MP3 file to it + +$ mp3driver test.mp3 + +And it will write a file, "out.wav", to the current directory. + +The actual decoder is in Codec/Audio/MP3. Change parts of it, run +the build command again, and see what happens. :-) + + + +=== Trouble? === + +If, for some reason, the above doesn't work, there's a manual method +of building the mp3driver program. Copy all *.hs, *.h and *.c files +to the same directory. Build the two C files: + +$ gcc -O2 -c c_imdct.c +$ gcc -O2 -c c_synth.c + +Change all "import Codec.Audio.MP3.XXX" in the Haskell source files +to "import XXX". Then: + +$ ghc c_imdct.o c_synth.o --make Driver.hs + diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,4 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain + diff --git a/example/Driver.hs b/example/Driver.hs new file mode 100644 --- /dev/null +++ b/example/Driver.hs @@ -0,0 +1,50 @@ +-- +-- Example program using the decoder. +-- +module Main where + +import qualified Data.ByteString as B +import System.IO +import System + +import qualified PCMWriter + +import Codec.Audio.MP3.Decoder +import Codec.Audio.MP3.Types + + +mainLoopX :: B.ByteString -> Handle -> IO () +mainLoopX contents outf = do loopInit (MP3Bitstream contents []) + emptyMP3DecodeState + where + loopInit bitstream decstate = helper (mp3Seek bitstream) + where + helper Nothing = error "Not an MP3." + helper (Just bitstream') = doUnpack bitstream' decstate 0 + + doUnpack bitstream decstate cnt = helper (mp3Unpack bitstream) + where + helper (bitstream', Nothing) = + do putStrLn $ "Skipped broken frame " ++ (show cnt) + doUnpack bitstream' emptyMP3DecodeState (cnt+1) + + helper (bitstream', Just mp3data) = + do let (decstate', ch0, ch1) = mp3Decode decstate mp3data + sr = mp3dataSampleRate mp3data + + putStrLn $ "Decoded frame " ++ (show cnt) ++ ": " ++ prettyData mp3data + + -- To the reader, that is, you: For fun, change mp3HybridFilterBank + -- so it doesn't do the synthesis step, and only returns the 18 + -- first samples. Then change the sr to sr/32. + PCMWriter.writeSamplerate outf sr -- (sr `div` 32) + PCMWriter.writeSamples outf ch0 ch1 + doUnpack bitstream' decstate' (cnt+1) + +main :: IO () +main = do args <- getArgs + contents <- B.readFile (head args) + outh <- openBinaryFile "out.wav" WriteMode + PCMWriter.writeHeader outh + mainLoopX contents outh + diff --git a/example/PCMWriter.hs b/example/PCMWriter.hs new file mode 100644 --- /dev/null +++ b/example/PCMWriter.hs @@ -0,0 +1,127 @@ +-- +-- module PCMWriter - For writing PCM WAV files. +-- This is a small simple (and very SLOW) library for demonstrating +-- the decoder. For more powerful manipulations of PCM +-- WAV, see HSoundFile at Hackage. +-- +-- This code is part of the Experimental Haskell MP3 Decoder, version 0.0.1. +-- Copyright (c) 2008 Bjorn Edstrom +-- +-- This software is provided 'as-is', without any express or implied +-- warranty. In no event will the authors be held liable for any damages +-- arising from the use of this software. +-- +-- Permission is granted to anyone to use this software for any purpose, +-- including commercial applications, and to alter it and redistribute it +-- freely, subject to the following restrictions: +-- +-- 1. The origin of this software must not be misrepresented; you must not +-- claim that you wrote the original software. If you use this software +-- in a product, an acknowledgment in the product documentation would be +-- appreciated but is not required. +-- +-- 2. Altered source versions must be plainly marked as such, and must not be +-- misrepresented as being the original software. +-- +-- 3. This notice may not be removed or altered from any source +-- distribution. +-- + +module PCMWriter ( + writeHeader + ,writeSamplerate + ,writeSamples +) where + +import Data.Word +import Data.Bits +import System.IO +import Char +import Control.Monad +import Control.Monad.State + +type PCMSample = Word16 + +fracToPCM :: RealFrac a => a -> PCMSample +fracToPCM x + | y <= (-32767) = fromIntegral (-32767) + | y >= 32767 = fromIntegral 32767 + | otherwise = fromIntegral y + where + y = round (x * 32767.0) + +class AudioSampleRepr a where + toPcmRepr :: a -> PCMSample + +instance AudioSampleRepr Double where + toPcmRepr = fracToPCM + +instance AudioSampleRepr Float where + toPcmRepr = fracToPCM + +-- Add other instances here. + +from16bit n = [chr . fromIntegral $ n .&. 0xff, + chr . fromIntegral $ n `shiftR` 8] +from32bit n = [chr . fromIntegral $ n .&. 0xff, + chr . fromIntegral $ (n `shiftR` 8) .&. 0xff, + chr . fromIntegral $ (n `shiftR` 16) .&. 0xff, + chr . fromIntegral $ (n `shiftR` 24) .&. 0xff] + +hWrite16 :: Handle -> Word16 -> IO () +hWrite16 handle n = do hPutStr handle (from16bit n) + +hWrite32 :: Handle -> Word32 -> IO () +hWrite32 handle n = do hPutStr handle (from32bit n) + +writeSamplerate :: Handle -> Int -> IO () +writeSamplerate handle sr = + do cur <- hTell handle + hSeek handle AbsoluteSeek 24 + hWrite32 handle (fromIntegral sr) + hWrite32 handle (fromIntegral sr * 2 * 2) + hSeek handle AbsoluteSeek cur + +writeNumSamples :: Handle -> Int -> IO () +writeNumSamples handle num = + do cur <- hTell handle + let count1 = (num * 2 * 2) + count2 = 36 + count1 + hSeek handle AbsoluteSeek 4 + hWrite32 handle (fromIntegral count2) + hSeek handle AbsoluteSeek 40 + hWrite32 handle (fromIntegral count1) + hSeek handle AbsoluteSeek cur + +writeHeader :: Handle -> IO () +writeHeader handle = + do write "RIFF" + write "\xff\xff\xff\xff" + write "WAVEfmt " + write32 16 + write16 1 + write16 2 -- Num. channels + write32 44100 -- Sample rate + write32 (44100 * 2 * 2) -- Derived from sample rate. + write16 4 + write16 16 + write "data" + write "\xff\xff\xff\xff" -- num samples + where + write = do hPutStr handle + write16 = do hWrite16 handle + write32 = do hWrite32 handle + +writeSamples :: AudioSampleRepr a => Handle -> [a] -> [a] -> IO () +writeSamples handle ch0 ch1 = + do zipWithM_ writeInterleaved ch0 ch1 + cur <- hTell handle + let totalsamples = fromIntegral $ (cur - 44) `div` (2*2) + writeNumSamples handle totalsamples + --hFlush handle + where + writeInterleaved ch0sample ch1sample = + do hWrite16 handle (toPcmRepr ch0sample) + hWrite16 handle (toPcmRepr ch1sample) + + diff --git a/mp3decoder.cabal b/mp3decoder.cabal new file mode 100644 --- /dev/null +++ b/mp3decoder.cabal @@ -0,0 +1,63 @@ +Name: mp3decoder +Version: 0.0.1 +Synopsis: MP3 decoder for teaching. +Description: + This is an MP3 decoder written (almost) completely in Haskell. + The current version is experimental software, written for + teaching purposes, and is currently too slow to be usable in + practice. For the accompanying article, se www.bjrn.se/mp3dec + +Copyright: Bjorn Edstrom, 2008 +Author: Bjorn Edstrom +Maintainer: be@bjrn.se +Homepage: http://www.bjrn.se/mp3dec +License: OtherLicense +License-file: LICENSE + +Category: Codec +Stability: experimental +Build-type: Simple +Cabal-version: >= 1.2 + +Extra-source-files: README, + Codec/Audio/MP3/c_synth.h, + Codec/Audio/MP3/c_imdct.h + +-- Comment out for library. + +--Library +-- Build-depends: base, bytestring, mtl, binary-strict +-- Exposed-modules: Codec.Audio.MP3.Decoder +-- Other-modules: Codec.Audio.MP3.Types, +-- Codec.Audio.MP3.Huffman, +-- Codec.Audio.MP3.SynthesisFilterBank, +-- Codec.Audio.MP3.Tables, +-- Codec.Audio.MP3.Unpack, +-- Codec.Audio.MP3.IMDCT, +-- Codec.Audio.MP3.HybridFilterBank +-- +-- hs-source-dirs: . +-- c-sources: Codec/Audio/MP3/c_synth.c, +-- Codec/Audio/MP3/c_imdct.c +-- cc-options: -O2 +-- ghc-options: -O2 + +Executable mp3driver + build-depends: base, bytestring, mtl, binary-strict, haskell98 + Main-Is: Driver.hs + hs-source-dirs: example, . + Other-Modules: Codec.Audio.MP3.Decoder + Codec.Audio.MP3.Types, + Codec.Audio.MP3.Huffman, + Codec.Audio.MP3.SynthesisFilterBank, + Codec.Audio.MP3.Tables, + Codec.Audio.MP3.Unpack, + Codec.Audio.MP3.IMDCT, + Codec.Audio.MP3.HybridFilterBank + PCMWriter + c-sources: Codec/Audio/MP3/c_synth.c, + Codec/Audio/MP3/c_imdct.c + cc-options: -O2 + ghc-options: -O2 + +