{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
module Codec.Picture.Jpg.Internal.DefaultTable( DctComponent( .. )
, HuffmanTree( .. )
, HuffmanTable
, HuffmanPackedTree
, MacroBlock
, QuantificationTable
, HuffmanWriterCode
, scaleQuantisationMatrix
, makeMacroBlock
, makeInverseTable
, buildHuffmanTree
, packHuffmanTree
, huffmanPackedDecode
, defaultChromaQuantizationTable
, defaultLumaQuantizationTable
, defaultAcChromaHuffmanTree
, defaultAcChromaHuffmanTable
, defaultAcLumaHuffmanTree
, defaultAcLumaHuffmanTable
, defaultDcChromaHuffmanTree
, defaultDcChromaHuffmanTable
, defaultDcLumaHuffmanTree
, defaultDcLumaHuffmanTable
) where
import Data.Int( Int16 )
import Foreign.Storable ( Storable )
import Control.Monad.ST( runST )
import qualified Data.Vector.Storable as SV
import qualified Data.Vector as V
import Data.Bits( unsafeShiftL, (.|.), (.&.) )
import Data.Word( Word8, Word16 )
import Data.List( foldl' )
import qualified Data.Vector.Storable.Mutable as M
import Codec.Picture.BitWriter
data HuffmanTree = Branch HuffmanTree HuffmanTree
| Leaf Word8
| Empty
deriving (HuffmanTree -> HuffmanTree -> Bool
(HuffmanTree -> HuffmanTree -> Bool)
-> (HuffmanTree -> HuffmanTree -> Bool) -> Eq HuffmanTree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HuffmanTree -> HuffmanTree -> Bool
$c/= :: HuffmanTree -> HuffmanTree -> Bool
== :: HuffmanTree -> HuffmanTree -> Bool
$c== :: HuffmanTree -> HuffmanTree -> Bool
Eq, Int -> HuffmanTree -> ShowS
[HuffmanTree] -> ShowS
HuffmanTree -> String
(Int -> HuffmanTree -> ShowS)
-> (HuffmanTree -> String)
-> ([HuffmanTree] -> ShowS)
-> Show HuffmanTree
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HuffmanTree] -> ShowS
$cshowList :: [HuffmanTree] -> ShowS
show :: HuffmanTree -> String
$cshow :: HuffmanTree -> String
showsPrec :: Int -> HuffmanTree -> ShowS
$cshowsPrec :: Int -> HuffmanTree -> ShowS
Show)
type HuffmanPackedTree = SV.Vector Word16
type HuffmanWriterCode = V.Vector (Word8, Word16)
packHuffmanTree :: HuffmanTree -> HuffmanPackedTree
packHuffmanTree :: HuffmanTree -> HuffmanPackedTree
packHuffmanTree tree :: HuffmanTree
tree = (forall s. ST s HuffmanPackedTree) -> HuffmanPackedTree
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s HuffmanPackedTree) -> HuffmanPackedTree)
-> (forall s. ST s HuffmanPackedTree) -> HuffmanPackedTree
forall a b. (a -> b) -> a -> b
$ do
MVector s Word16
table <- Int -> Word16 -> ST s (MVector (PrimState (ST s)) Word16)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> a -> m (MVector (PrimState m) a)
M.replicate 512 0x8000
let aux :: HuffmanTree -> Int -> ST s Int
aux (HuffmanTree
Empty) idx :: Int
idx = Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
aux (Leaf v :: Word8
v) idx :: Int
idx = do
(MVector s Word16
MVector (PrimState (ST s)) Word16
table MVector (PrimState (ST s)) Word16 -> Int -> Word16 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` Int
idx) (Word16 -> ST s ()) -> Word16 -> ST s ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. 0x4000
Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
aux (Branch i1 :: HuffmanTree
i1@(Leaf _) i2 :: HuffmanTree
i2@(Leaf _)) idx :: Int
idx =
HuffmanTree -> Int -> ST s Int
aux HuffmanTree
i1 Int
idx ST s Int -> (Int -> ST s Int) -> ST s Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= HuffmanTree -> Int -> ST s Int
aux HuffmanTree
i2
aux (Branch i1 :: HuffmanTree
i1@(Leaf _) i2 :: HuffmanTree
i2) idx :: Int
idx = do
Int
_ <- HuffmanTree -> Int -> ST s Int
aux HuffmanTree
i1 Int
idx
Int
ix2 <- HuffmanTree -> Int -> ST s Int
aux HuffmanTree
i2 (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2
(MVector s Word16
MVector (PrimState (ST s)) Word16
table MVector (PrimState (ST s)) Word16 -> Int -> Word16 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)) (Word16 -> ST s ()) -> Word16 -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2
Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
ix2
aux (Branch i1 :: HuffmanTree
i1 i2 :: HuffmanTree
i2@(Leaf _)) idx :: Int
idx = do
Int
ix1 <- HuffmanTree -> Int -> ST s Int
aux HuffmanTree
i1 (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2)
Int
_ <- HuffmanTree -> Int -> ST s Int
aux HuffmanTree
i2 (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
(MVector s Word16
MVector (PrimState (ST s)) Word16
table MVector (PrimState (ST s)) Word16 -> Int -> Word16 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` Int
idx) (Word16 -> ST s ()) -> (Int -> Word16) -> Int -> ST s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ST s ()) -> Int -> ST s ()
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2
Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
ix1
aux (Branch i1 :: HuffmanTree
i1 i2 :: HuffmanTree
i2) idx :: Int
idx = do
Int
ix1 <- HuffmanTree -> Int -> ST s Int
aux HuffmanTree
i1 (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2)
Int
ix2 <- HuffmanTree -> Int -> ST s Int
aux HuffmanTree
i2 Int
ix1
(MVector s Word16
MVector (PrimState (ST s)) Word16
table MVector (PrimState (ST s)) Word16 -> Int -> Word16 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` Int
idx) (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2)
(MVector s Word16
MVector (PrimState (ST s)) Word16
table MVector (PrimState (ST s)) Word16 -> Int -> Word16 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)) (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ix1)
Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
ix2
Int
_ <- HuffmanTree -> Int -> ST s Int
aux HuffmanTree
tree 0
MVector (PrimState (ST s)) Word16 -> ST s HuffmanPackedTree
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
SV.unsafeFreeze MVector s Word16
MVector (PrimState (ST s)) Word16
table
makeInverseTable :: HuffmanTree -> HuffmanWriterCode
makeInverseTable :: HuffmanTree -> HuffmanWriterCode
makeInverseTable t :: HuffmanTree
t = Int -> (Word8, Word16) -> HuffmanWriterCode
forall a. Int -> a -> Vector a
V.replicate 255 (0,0) HuffmanWriterCode -> [(Int, (Word8, Word16))] -> HuffmanWriterCode
forall a. Vector a -> [(Int, a)] -> Vector a
V.// Word8 -> Word16 -> HuffmanTree -> [(Int, (Word8, Word16))]
forall a a a.
(Num a, Num a, Num a, Bits a) =>
a -> a -> HuffmanTree -> [(a, (a, a))]
inner 0 0 HuffmanTree
t
where inner :: a -> a -> HuffmanTree -> [(a, (a, a))]
inner _ _ Empty = []
inner depth :: a
depth code :: a
code (Leaf v :: Word8
v) = [(Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v, (a
depth, a
code))]
inner depth :: a
depth code :: a
code (Branch l :: HuffmanTree
l r :: HuffmanTree
r) =
a -> a -> HuffmanTree -> [(a, (a, a))]
inner (a
depth a -> a -> a
forall a. Num a => a -> a -> a
+ 1) a
shifted HuffmanTree
l [(a, (a, a))] -> [(a, (a, a))] -> [(a, (a, a))]
forall a. [a] -> [a] -> [a]
++ a -> a -> HuffmanTree -> [(a, (a, a))]
inner (a
depth a -> a -> a
forall a. Num a => a -> a -> a
+ 1) (a
shifted a -> a -> a
forall a. Bits a => a -> a -> a
.|. 1) HuffmanTree
r
where shifted :: a
shifted = a
code a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftL` 1
type MacroBlock a = SV.Vector a
type QuantificationTable = MacroBlock Int16
makeMacroBlock :: (Storable a) => [a] -> MacroBlock a
makeMacroBlock :: [a] -> MacroBlock a
makeMacroBlock = Int -> [a] -> MacroBlock a
forall a. Storable a => Int -> [a] -> Vector a
SV.fromListN 64
data DctComponent = DcComponent | AcComponent
deriving (DctComponent -> DctComponent -> Bool
(DctComponent -> DctComponent -> Bool)
-> (DctComponent -> DctComponent -> Bool) -> Eq DctComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DctComponent -> DctComponent -> Bool
$c/= :: DctComponent -> DctComponent -> Bool
== :: DctComponent -> DctComponent -> Bool
$c== :: DctComponent -> DctComponent -> Bool
Eq, Int -> DctComponent -> ShowS
[DctComponent] -> ShowS
DctComponent -> String
(Int -> DctComponent -> ShowS)
-> (DctComponent -> String)
-> ([DctComponent] -> ShowS)
-> Show DctComponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DctComponent] -> ShowS
$cshowList :: [DctComponent] -> ShowS
show :: DctComponent -> String
$cshow :: DctComponent -> String
showsPrec :: Int -> DctComponent -> ShowS
$cshowsPrec :: Int -> DctComponent -> ShowS
Show)
buildHuffmanTree :: [[Word8]] -> HuffmanTree
buildHuffmanTree :: [[Word8]] -> HuffmanTree
buildHuffmanTree table :: [[Word8]]
table = (HuffmanTree -> (Int, Word8) -> HuffmanTree)
-> HuffmanTree -> [(Int, Word8)] -> HuffmanTree
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' HuffmanTree -> (Int, Word8) -> HuffmanTree
forall a. (Eq a, Num a) => HuffmanTree -> (a, Word8) -> HuffmanTree
insertHuffmanVal HuffmanTree
Empty
([(Int, Word8)] -> HuffmanTree)
-> ([(Int, [Word8])] -> [(Int, Word8)])
-> [(Int, [Word8])]
-> HuffmanTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, [Word8]) -> [(Int, Word8)])
-> [(Int, [Word8])] -> [(Int, Word8)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(i :: Int
i, t :: [Word8]
t) -> (Word8 -> (Int, Word8)) -> [Word8] -> [(Int, Word8)]
forall a b. (a -> b) -> [a] -> [b]
map (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1,) [Word8]
t)
([(Int, [Word8])] -> HuffmanTree)
-> [(Int, [Word8])] -> HuffmanTree
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Word8]] -> [(Int, [Word8])]
forall a b. [a] -> [b] -> [(a, b)]
zip ([0..] :: [Int]) [[Word8]]
table
where isTreeFullyDefined :: HuffmanTree -> Bool
isTreeFullyDefined Empty = Bool
False
isTreeFullyDefined (Leaf _) = Bool
True
isTreeFullyDefined (Branch l :: HuffmanTree
l r :: HuffmanTree
r) = HuffmanTree -> Bool
isTreeFullyDefined HuffmanTree
l Bool -> Bool -> Bool
&& HuffmanTree -> Bool
isTreeFullyDefined HuffmanTree
r
insertHuffmanVal :: HuffmanTree -> (a, Word8) -> HuffmanTree
insertHuffmanVal Empty (0, val :: Word8
val) = Word8 -> HuffmanTree
Leaf Word8
val
insertHuffmanVal Empty (d :: a
d, val :: Word8
val) = HuffmanTree -> HuffmanTree -> HuffmanTree
Branch (HuffmanTree -> (a, Word8) -> HuffmanTree
insertHuffmanVal HuffmanTree
Empty (a
d a -> a -> a
forall a. Num a => a -> a -> a
- 1, Word8
val)) HuffmanTree
Empty
insertHuffmanVal (Branch l :: HuffmanTree
l r :: HuffmanTree
r) (d :: a
d, val :: Word8
val)
| HuffmanTree -> Bool
isTreeFullyDefined HuffmanTree
l = HuffmanTree -> HuffmanTree -> HuffmanTree
Branch HuffmanTree
l (HuffmanTree -> (a, Word8) -> HuffmanTree
insertHuffmanVal HuffmanTree
r (a
d a -> a -> a
forall a. Num a => a -> a -> a
- 1, Word8
val))
| Bool
otherwise = HuffmanTree -> HuffmanTree -> HuffmanTree
Branch (HuffmanTree -> (a, Word8) -> HuffmanTree
insertHuffmanVal HuffmanTree
l (a
d a -> a -> a
forall a. Num a => a -> a -> a
- 1, Word8
val)) HuffmanTree
r
insertHuffmanVal (Leaf _) _ = String -> HuffmanTree
forall a. HasCallStack => String -> a
error "Inserting in value, shouldn't happen"
scaleQuantisationMatrix :: Int -> QuantificationTable -> QuantificationTable
scaleQuantisationMatrix :: Int -> QuantificationTable -> QuantificationTable
scaleQuantisationMatrix quality :: Int
quality
| Int
quality Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = Int -> QuantificationTable -> QuantificationTable
scaleQuantisationMatrix 0
| Int
quality Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = (Int16 -> Int16) -> QuantificationTable -> QuantificationTable
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
SV.map (Int -> Int16 -> Int16
forall a a c. (Integral a, Integral a, Num c) => a -> a -> c
scale (10000 :: Int))
| Int
quality Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 50 = let qq :: Int
qq = 5000 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
quality
in (Int16 -> Int16) -> QuantificationTable -> QuantificationTable
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
SV.map (Int -> Int16 -> Int16
forall a a c. (Integral a, Integral a, Num c) => a -> a -> c
scale Int
qq)
| Bool
otherwise = (Int16 -> Int16) -> QuantificationTable -> QuantificationTable
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
SV.map (Int -> Int16 -> Int16
forall a a c. (Integral a, Integral a, Num c) => a -> a -> c
scale Int
q)
where q :: Int
q = 200 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
quality Int -> Int -> Int
forall a. Num a => a -> a -> a
* 2
scale :: a -> a -> c
scale coeff :: a
coeff i :: a
i = a -> c
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> c) -> (a -> a) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a. Ord a => a -> a -> a
min 255
(a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a. Ord a => a -> a -> a
max 1
(a -> c) -> a -> c
forall a b. (a -> b) -> a -> b
$ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i a -> a -> a
forall a. Num a => a -> a -> a
* a
coeff a -> a -> a
forall a. Integral a => a -> a -> a
`div` 100
huffmanPackedDecode :: HuffmanPackedTree -> BoolReader s Word8
huffmanPackedDecode :: HuffmanPackedTree -> BoolReader s Word8
huffmanPackedDecode table :: HuffmanPackedTree
table = BoolReader s Bool
forall s. BoolReader s Bool
getNextBitJpg BoolReader s Bool
-> (Bool -> BoolReader s Word8) -> BoolReader s Word8
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word16 -> Bool -> BoolReader s Word8
forall a s. Num a => Word16 -> Bool -> StateT BoolState (ST s) a
aux 0
where aux :: Word16 -> Bool -> StateT BoolState (ST s) a
aux idx :: Word16
idx b :: Bool
b
| (Word16
v Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. 0x8000) Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 = a -> StateT BoolState (ST s) a
forall (m :: * -> *) a. Monad m => a -> m a
return 0
| (Word16
v Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. 0x4000) Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 = a -> StateT BoolState (ST s) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> StateT BoolState (ST s) a)
-> (Word16 -> a) -> Word16 -> StateT BoolState (ST s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> StateT BoolState (ST s) a)
-> Word16 -> StateT BoolState (ST s) a
forall a b. (a -> b) -> a -> b
$ Word16
v Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. 0xFF
| Bool
otherwise = BoolReader s Bool
forall s. BoolReader s Bool
getNextBitJpg BoolReader s Bool
-> (Bool -> StateT BoolState (ST s) a) -> StateT BoolState (ST s) a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word16 -> Bool -> StateT BoolState (ST s) a
aux Word16
v
where tableIndex :: Word16
tableIndex | Bool
b = Word16
idx Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ 1
| Bool
otherwise = Word16
idx
v :: Word16
v = HuffmanPackedTree
table HuffmanPackedTree -> Int -> Word16
forall a. Storable a => Vector a -> Int -> a
`SV.unsafeIndex` Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
tableIndex
defaultLumaQuantizationTable :: QuantificationTable
defaultLumaQuantizationTable :: QuantificationTable
defaultLumaQuantizationTable = [Int16] -> QuantificationTable
forall a. Storable a => [a] -> MacroBlock a
makeMacroBlock
[16, 11, 10, 16, 24, 40, 51, 61
,12, 12, 14, 19, 26, 58, 60, 55
,14, 13, 16, 24, 40, 57, 69, 56
,14, 17, 22, 29, 51, 87, 80, 62
,18, 22, 37, 56, 68, 109, 103, 77
,24, 35, 55, 64, 81, 104, 113, 92
,49, 64, 78, 87, 103, 121, 120, 101
,72, 92, 95, 98, 112, 100, 103, 99
]
defaultChromaQuantizationTable :: QuantificationTable
defaultChromaQuantizationTable :: QuantificationTable
defaultChromaQuantizationTable = [Int16] -> QuantificationTable
forall a. Storable a => [a] -> MacroBlock a
makeMacroBlock
[17, 18, 24, 47, 99, 99, 99, 99
,18, 21, 26, 66, 99, 99, 99, 99
,24, 26, 56, 99, 99, 99, 99, 99
,47, 66, 99, 99, 99, 99, 99, 99
,99, 99, 99, 99, 99, 99, 99, 99
,99, 99, 99, 99, 99, 99, 99, 99
,99, 99, 99, 99, 99, 99, 99, 99
,99, 99, 99, 99, 99, 99, 99, 99
]
defaultDcLumaHuffmanTree :: HuffmanTree
defaultDcLumaHuffmanTree :: HuffmanTree
defaultDcLumaHuffmanTree = [[Word8]] -> HuffmanTree
buildHuffmanTree [[Word8]]
defaultDcLumaHuffmanTable
defaultDcLumaHuffmanTable :: HuffmanTable
defaultDcLumaHuffmanTable :: [[Word8]]
defaultDcLumaHuffmanTable =
[ []
, [0]
, [1, 2, 3, 4, 5]
, [6]
, [7]
, [8]
, [9]
, [10]
, [11]
, []
, []
, []
, []
, []
, []
, []
]
defaultDcChromaHuffmanTree :: HuffmanTree
defaultDcChromaHuffmanTree :: HuffmanTree
defaultDcChromaHuffmanTree = [[Word8]] -> HuffmanTree
buildHuffmanTree [[Word8]]
defaultDcChromaHuffmanTable
defaultDcChromaHuffmanTable :: HuffmanTable
defaultDcChromaHuffmanTable :: [[Word8]]
defaultDcChromaHuffmanTable =
[ []
, [0, 1, 2]
, [3]
, [4]
, [5]
, [6]
, [7]
, [8]
, [9]
, [10]
, [11]
, []
, []
, []
, []
, []
]
defaultAcLumaHuffmanTree :: HuffmanTree
defaultAcLumaHuffmanTree :: HuffmanTree
defaultAcLumaHuffmanTree = [[Word8]] -> HuffmanTree
buildHuffmanTree [[Word8]]
defaultAcLumaHuffmanTable
defaultAcLumaHuffmanTable :: HuffmanTable
defaultAcLumaHuffmanTable :: [[Word8]]
defaultAcLumaHuffmanTable =
[ []
, [0x01, 0x02]
, [0x03]
, [0x00, 0x04, 0x11]
, [0x05, 0x12, 0x21]
, [0x31, 0x41]
, [0x06, 0x13, 0x51, 0x61]
, [0x07, 0x22, 0x71]
, [0x14, 0x32, 0x81, 0x91, 0xA1]
, [0x08, 0x23, 0x42, 0xB1, 0xC1]
, [0x15, 0x52, 0xD1, 0xF0]
, [0x24, 0x33, 0x62, 0x72]
, []
, []
, [0x82]
, [0x09, 0x0A, 0x16, 0x17, 0x18, 0x19, 0x1A, 0x25, 0x26, 0x27, 0x28, 0x29, 0x2A, 0x34, 0x35
,0x36, 0x37, 0x38, 0x39, 0x3A, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0x4A, 0x53, 0x54
,0x55, 0x56, 0x57, 0x58, 0x59, 0x5A, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0x6A, 0x73
,0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, 0x8A
,0x92, 0x93, 0x94, 0x95, 0x96, 0x97, 0x98, 0x99, 0x9A, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7
,0xA8, 0xA9, 0xAA, 0xB2, 0xB3, 0xB4, 0xB5, 0xB6, 0xB7, 0xB8, 0xB9, 0xBA, 0xC2, 0xC3, 0xC4
,0xC5, 0xC6, 0xC7, 0xC8, 0xC9, 0xCA, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6, 0xD7, 0xD8, 0xD9, 0xDA
,0xE1, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, 0xE7, 0xE8, 0xE9, 0xEA, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5
,0xF6, 0xF7, 0xF8, 0xF9, 0xFA]
]
type HuffmanTable = [[Word8]]
defaultAcChromaHuffmanTree :: HuffmanTree
defaultAcChromaHuffmanTree :: HuffmanTree
defaultAcChromaHuffmanTree = [[Word8]] -> HuffmanTree
buildHuffmanTree [[Word8]]
defaultAcChromaHuffmanTable
defaultAcChromaHuffmanTable :: HuffmanTable
defaultAcChromaHuffmanTable :: [[Word8]]
defaultAcChromaHuffmanTable =
[ []
, [0x00, 0x01]
, [0x02]
, [0x03, 0x11]
, [0x04, 0x05, 0x21, 0x31]
, [0x06, 0x12, 0x41, 0x51]
, [0x07, 0x61, 0x71]
, [0x13, 0x22, 0x32, 0x81]
, [0x08, 0x14, 0x42, 0x91, 0xA1, 0xB1, 0xC1]
, [0x09, 0x23, 0x33, 0x52, 0xF0]
, [0x15, 0x62, 0x72, 0xD1]
, [0x0A, 0x16, 0x24, 0x34]
, []
, [0xE1]
, [0x25, 0xF1]
, [ 0x17, 0x18, 0x19, 0x1A, 0x26, 0x27, 0x28, 0x29, 0x2A, 0x35
, 0x36, 0x37, 0x38, 0x39, 0x3A, 0x43, 0x44, 0x45, 0x46, 0x47
, 0x48, 0x49, 0x4A, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59
, 0x5A, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0x6A, 0x73
, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A, 0x82, 0x83, 0x84
, 0x85, 0x86, 0x87, 0x88, 0x89, 0x8A, 0x92, 0x93, 0x94, 0x95
, 0x96, 0x97, 0x98, 0x99, 0x9A, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6
, 0xA7, 0xA8, 0xA9, 0xAA, 0xB2, 0xB3, 0xB4, 0xB5, 0xB6, 0xB7
, 0xB8, 0xB9, 0xBA, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7, 0xC8
, 0xC9, 0xCA, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6, 0xD7, 0xD8, 0xD9
, 0xDA, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, 0xE7, 0xE8, 0xE9, 0xEA
, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7, 0xF8, 0xF9, 0xFA
]
]