{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
-- | Module used by the jpeg decoder internally, shouldn't be used

-- in user code.

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 Control.DeepSeq( NFData(..) )
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 GHC.Generics( Generic )

import Codec.Picture.BitWriter

-- | Tree storing the code used for huffman encoding.

data HuffmanTree = Branch HuffmanTree HuffmanTree -- ^ If bit is 0 take the first subtree, if 1, the right.

                 | Leaf Word8       -- ^ We should output the value

                 | Empty            -- ^ no value present

                 deriving (HuffmanTree -> HuffmanTree -> Bool
(HuffmanTree -> HuffmanTree -> Bool)
-> (HuffmanTree -> HuffmanTree -> Bool) -> Eq HuffmanTree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HuffmanTree -> HuffmanTree -> Bool
== :: HuffmanTree -> HuffmanTree -> Bool
$c/= :: HuffmanTree -> HuffmanTree -> Bool
/= :: 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
$cshowsPrec :: Int -> HuffmanTree -> ShowS
showsPrec :: Int -> HuffmanTree -> ShowS
$cshow :: HuffmanTree -> String
show :: HuffmanTree -> String
$cshowList :: [HuffmanTree] -> ShowS
showList :: [HuffmanTree] -> ShowS
Show)

type HuffmanPackedTree = SV.Vector Word16

type HuffmanWriterCode = V.Vector (Word8, Word16)

packHuffmanTree :: HuffmanTree -> HuffmanPackedTree
packHuffmanTree :: HuffmanTree -> HuffmanPackedTree
packHuffmanTree 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 (PrimState (ST 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 Int
512 Word16
0x8000
    let aux :: HuffmanTree -> Int -> ST s Int
aux (HuffmanTree
Empty) Int
idx = Int -> ST s Int
forall a. a -> ST s a
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
+ Int
1
        aux (Leaf Word8
v) Int
idx = do
            (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
.|. Word16
0x4000
            Int -> ST s Int
forall a. a -> ST s a
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
+ Int
1

        aux (Branch i1 :: HuffmanTree
i1@(Leaf Word8
_) i2 :: HuffmanTree
i2@(Leaf Word8
_)) Int
idx =
            HuffmanTree -> Int -> ST s Int
aux HuffmanTree
i1 Int
idx ST s Int -> (Int -> ST s Int) -> ST s Int
forall a b. ST s a -> (a -> ST s b) -> ST s b
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 Word8
_) HuffmanTree
i2) 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
+ Int
2
            (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
+ Int
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
+ Int
2
            Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
ix2

        aux (Branch HuffmanTree
i1 i2 :: HuffmanTree
i2@(Leaf Word8
_)) 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
+ Int
2)
            Int
_ <- HuffmanTree -> Int -> ST s Int
aux HuffmanTree
i2 (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            (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
+ Int
2
            Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
ix1

        aux (Branch HuffmanTree
i1 HuffmanTree
i2) 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
+ Int
2)
            Int
ix2 <- HuffmanTree -> Int -> ST s Int
aux HuffmanTree
i2 Int
ix1
            (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
+ Int
2)
            (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
+ Int
1)) (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ix1)
            Int -> ST s Int
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
ix2
    Int
_ <- HuffmanTree -> Int -> ST s Int
aux HuffmanTree
tree Int
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 (PrimState (ST s)) Word16
table

makeInverseTable :: HuffmanTree -> HuffmanWriterCode
makeInverseTable :: HuffmanTree -> HuffmanWriterCode
makeInverseTable HuffmanTree
t = Int -> (Word8, Word16) -> HuffmanWriterCode
forall a. Int -> a -> Vector a
V.replicate Int
255 (Word8
0,Word16
0) HuffmanWriterCode -> [(Int, (Word8, Word16))] -> HuffmanWriterCode
forall a. Vector a -> [(Int, a)] -> Vector a
V.// Word8 -> Word16 -> HuffmanTree -> [(Int, (Word8, Word16))]
forall {a} {t} {t}.
(Num a, Num t, Num t, Bits t) =>
t -> t -> HuffmanTree -> [(a, (t, t))]
inner Word8
0 Word16
0 HuffmanTree
t
  where inner :: t -> t -> HuffmanTree -> [(a, (t, t))]
inner t
_     t
_     HuffmanTree
Empty   = []
        inner t
depth t
code (Leaf Word8
v) = [(Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v, (t
depth, t
code))]
        inner t
depth t
code (Branch HuffmanTree
l HuffmanTree
r) =
          t -> t -> HuffmanTree -> [(a, (t, t))]
inner (t
depth t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) t
shifted HuffmanTree
l [(a, (t, t))] -> [(a, (t, t))] -> [(a, (t, t))]
forall a. [a] -> [a] -> [a]
++ t -> t -> HuffmanTree -> [(a, (t, t))]
inner (t
depth t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) (t
shifted t -> t -> t
forall a. Bits a => a -> a -> a
.|. t
1) HuffmanTree
r
            where shifted :: t
shifted = t
code t -> Int -> t
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1

-- | Represent a compact array of 8 * 8 values. The size

-- is not guarenteed by type system, but if makeMacroBlock is

-- used, everything should be fine size-wise

type MacroBlock a = SV.Vector a

type QuantificationTable = MacroBlock Int16

-- | Helper function to create pure macro block of the good size.

makeMacroBlock :: (Storable a) => [a] -> MacroBlock a
makeMacroBlock :: forall a. Storable a => [a] -> MacroBlock a
makeMacroBlock = Int -> [a] -> Vector a
forall a. Storable a => Int -> [a] -> Vector a
SV.fromListN Int
64

-- | Enumeration used to search in the tables for different components.

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
$c== :: DctComponent -> DctComponent -> Bool
== :: DctComponent -> DctComponent -> Bool
$c/= :: DctComponent -> DctComponent -> Bool
/= :: 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
$cshowsPrec :: Int -> DctComponent -> ShowS
showsPrec :: Int -> DctComponent -> ShowS
$cshow :: DctComponent -> String
show :: DctComponent -> String
$cshowList :: [DctComponent] -> ShowS
showList :: [DctComponent] -> ShowS
Show, (forall x. DctComponent -> Rep DctComponent x)
-> (forall x. Rep DctComponent x -> DctComponent)
-> Generic DctComponent
forall x. Rep DctComponent x -> DctComponent
forall x. DctComponent -> Rep DctComponent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DctComponent -> Rep DctComponent x
from :: forall x. DctComponent -> Rep DctComponent x
$cto :: forall x. Rep DctComponent x -> DctComponent
to :: forall x. Rep DctComponent x -> DctComponent
Generic)
instance NFData DctComponent

-- | Transform parsed coefficients from the jpeg header to a

-- tree which can be used to decode data.

buildHuffmanTree :: [[Word8]] -> HuffmanTree
buildHuffmanTree :: [[Word8]] -> HuffmanTree
buildHuffmanTree [[Word8]]
table = (HuffmanTree -> (Int, Word8) -> HuffmanTree)
-> HuffmanTree -> [(Int, Word8)] -> HuffmanTree
forall b a. (b -> a -> b) -> b -> [a] -> b
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 (\(Int
i, [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
+ Int
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 ([Int
0..] :: [Int]) [[Word8]]
table
  where isTreeFullyDefined :: HuffmanTree -> Bool
isTreeFullyDefined HuffmanTree
Empty = Bool
False
        isTreeFullyDefined (Leaf Word8
_) = Bool
True
        isTreeFullyDefined (Branch HuffmanTree
l HuffmanTree
r) = HuffmanTree -> Bool
isTreeFullyDefined HuffmanTree
l Bool -> Bool -> Bool
&& HuffmanTree -> Bool
isTreeFullyDefined HuffmanTree
r

        insertHuffmanVal :: HuffmanTree -> (a, Word8) -> HuffmanTree
insertHuffmanVal HuffmanTree
Empty (a
0, Word8
val) = Word8 -> HuffmanTree
Leaf Word8
val
        insertHuffmanVal HuffmanTree
Empty (a
d, 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
- a
1, Word8
val)) HuffmanTree
Empty
        insertHuffmanVal (Branch HuffmanTree
l HuffmanTree
r) (a
d, 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
- 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
- a
1, Word8
val)) HuffmanTree
r
        insertHuffmanVal (Leaf Word8
_) (a, Word8)
_ = String -> HuffmanTree
forall a. HasCallStack => String -> a
error String
"Inserting in value, shouldn't happen"

scaleQuantisationMatrix :: Int -> QuantificationTable -> QuantificationTable 
scaleQuantisationMatrix :: Int -> QuantificationTable -> QuantificationTable
scaleQuantisationMatrix Int
quality
    | Int
quality Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> QuantificationTable -> QuantificationTable
scaleQuantisationMatrix Int
0
        -- shouldn't show much difference than with 1,

        -- but hey, at least we're complete

    | Int
quality Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Int16 -> Int16) -> QuantificationTable -> QuantificationTable
forall a b.
(Storable a, Storable b) =>
(a -> b) -> Vector a -> Vector b
SV.map (Int -> Int16 -> Int16
forall {b} {a} {c}. (Integral b, Integral a, Num c) => b -> a -> c
scale (Int
10000 :: Int))
    | Int
quality Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
50 = let qq :: Int
qq = Int
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 {b} {a} {c}. (Integral b, Integral a, Num c) => b -> 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 {b} {a} {c}. (Integral b, Integral a, Num c) => b -> a -> c
scale Int
q)
          where q :: Int
q = Int
200 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
quality Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
                scale :: b -> a -> c
scale b
coeff a
i = b -> c
forall a b. (Integral a, Num b) => a -> b
fromIntegral (b -> c) -> (b -> b) -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b -> b
forall a. Ord a => a -> a -> a
min b
255 
                                             (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b -> b
forall a. Ord a => a -> a -> a
max b
1 
                                             (b -> c) -> b -> c
forall a b. (a -> b) -> a -> b
$ a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i b -> b -> b
forall a. Num a => a -> a -> a
* b
coeff b -> b -> b
forall a. Integral a => a -> a -> a
`div` b
100

huffmanPackedDecode :: HuffmanPackedTree -> BoolReader s Word8
huffmanPackedDecode :: forall s. HuffmanPackedTree -> BoolReader s Word8
huffmanPackedDecode HuffmanPackedTree
table = BoolReader s Bool
forall s. BoolReader s Bool
getNextBitJpg BoolReader s Bool
-> (Bool -> StateT BoolState (ST s) Word8)
-> StateT BoolState (ST s) Word8
forall a b.
StateT BoolState (ST s) a
-> (a -> StateT BoolState (ST s) b) -> StateT BoolState (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word16 -> Bool -> StateT BoolState (ST s) Word8
forall {a} {s}.
Num a =>
Word16 -> Bool -> StateT BoolState (ST s) a
aux Word16
0
  where aux :: Word16 -> Bool -> StateT BoolState (ST s) a
aux Word16
idx Bool
b
            | (Word16
v Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x8000) Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
0 = a -> StateT BoolState (ST s) a
forall a. a -> StateT BoolState (ST s) a
forall (m :: * -> *) a. Monad m => a -> m a
return  a
0
            | (Word16
v Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x4000) Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word16
0 = a -> StateT BoolState (ST s) a
forall a. 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
.&. Word16
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 a b.
StateT BoolState (ST s) a
-> (a -> StateT BoolState (ST s) b) -> StateT BoolState (ST s) b
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
+ Word16
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
    [Int16
16, Int16
11, Int16
10, Int16
16,  Int16
24,  Int16
40,  Int16
51,  Int16
61
    ,Int16
12, Int16
12, Int16
14, Int16
19,  Int16
26,  Int16
58,  Int16
60,  Int16
55
    ,Int16
14, Int16
13, Int16
16, Int16
24,  Int16
40,  Int16
57,  Int16
69,  Int16
56
    ,Int16
14, Int16
17, Int16
22, Int16
29,  Int16
51,  Int16
87,  Int16
80,  Int16
62
    ,Int16
18, Int16
22, Int16
37, Int16
56,  Int16
68, Int16
109, Int16
103,  Int16
77
    ,Int16
24, Int16
35, Int16
55, Int16
64,  Int16
81, Int16
104, Int16
113,  Int16
92
    ,Int16
49, Int16
64, Int16
78, Int16
87, Int16
103, Int16
121, Int16
120, Int16
101
    ,Int16
72, Int16
92, Int16
95, Int16
98, Int16
112, Int16
100, Int16
103,  Int16
99
    ]

defaultChromaQuantizationTable :: QuantificationTable
defaultChromaQuantizationTable :: QuantificationTable
defaultChromaQuantizationTable = [Int16] -> QuantificationTable
forall a. Storable a => [a] -> MacroBlock a
makeMacroBlock
    [Int16
17, Int16
18, Int16
24, Int16
47, Int16
99, Int16
99, Int16
99, Int16
99
    ,Int16
18, Int16
21, Int16
26, Int16
66, Int16
99, Int16
99, Int16
99, Int16
99
    ,Int16
24, Int16
26, Int16
56, Int16
99, Int16
99, Int16
99, Int16
99, Int16
99
    ,Int16
47, Int16
66, Int16
99, Int16
99, Int16
99, Int16
99, Int16
99, Int16
99
    ,Int16
99, Int16
99, Int16
99, Int16
99, Int16
99, Int16
99, Int16
99, Int16
99
    ,Int16
99, Int16
99, Int16
99, Int16
99, Int16
99, Int16
99, Int16
99, Int16
99
    ,Int16
99, Int16
99, Int16
99, Int16
99, Int16
99, Int16
99, Int16
99, Int16
99
    ,Int16
99, Int16
99, Int16
99, Int16
99, Int16
99, Int16
99, Int16
99, Int16
99
    ]

defaultDcLumaHuffmanTree :: HuffmanTree
defaultDcLumaHuffmanTree :: HuffmanTree
defaultDcLumaHuffmanTree = [[Word8]] -> HuffmanTree
buildHuffmanTree [[Word8]]
defaultDcLumaHuffmanTable

-- | From the Table K.3 of ITU-81 (p153)

defaultDcLumaHuffmanTable :: HuffmanTable
defaultDcLumaHuffmanTable :: [[Word8]]
defaultDcLumaHuffmanTable =
    [ []
    , [Word8
0]
    , [Word8
1, Word8
2, Word8
3, Word8
4, Word8
5]
    , [Word8
6]
    , [Word8
7]
    , [Word8
8]
    , [Word8
9]
    , [Word8
10]
    , [Word8
11]
    , []
    , []
    , []
    , []
    , []
    , []
    , []
    ]

defaultDcChromaHuffmanTree :: HuffmanTree
defaultDcChromaHuffmanTree :: HuffmanTree
defaultDcChromaHuffmanTree = [[Word8]] -> HuffmanTree
buildHuffmanTree [[Word8]]
defaultDcChromaHuffmanTable

-- | From the Table K.4 of ITU-81 (p153)

defaultDcChromaHuffmanTable :: HuffmanTable
defaultDcChromaHuffmanTable :: [[Word8]]
defaultDcChromaHuffmanTable = 
    [ []
    , [Word8
0, Word8
1, Word8
2]
    , [Word8
3]
    , [Word8
4]
    , [Word8
5]
    , [Word8
6]
    , [Word8
7]
    , [Word8
8]
    , [Word8
9]
    , [Word8
10]
    , [Word8
11]
    , []
    , []
    , []
    , []
    , []
    ]

defaultAcLumaHuffmanTree :: HuffmanTree
defaultAcLumaHuffmanTree :: HuffmanTree
defaultAcLumaHuffmanTree = [[Word8]] -> HuffmanTree
buildHuffmanTree [[Word8]]
defaultAcLumaHuffmanTable

-- | From the Table K.5 of ITU-81 (p154)

defaultAcLumaHuffmanTable :: HuffmanTable
defaultAcLumaHuffmanTable :: [[Word8]]
defaultAcLumaHuffmanTable =
    [ []
    , [Word8
0x01, Word8
0x02]
    , [Word8
0x03]
    , [Word8
0x00, Word8
0x04, Word8
0x11]
    , [Word8
0x05, Word8
0x12, Word8
0x21]
    , [Word8
0x31, Word8
0x41]
    , [Word8
0x06, Word8
0x13, Word8
0x51, Word8
0x61]
    , [Word8
0x07, Word8
0x22, Word8
0x71]
    , [Word8
0x14, Word8
0x32, Word8
0x81, Word8
0x91, Word8
0xA1]
    , [Word8
0x08, Word8
0x23, Word8
0x42, Word8
0xB1, Word8
0xC1]
    , [Word8
0x15, Word8
0x52, Word8
0xD1, Word8
0xF0]
    , [Word8
0x24, Word8
0x33, Word8
0x62, Word8
0x72]
    , []
    , []
    , [Word8
0x82]
    , [Word8
0x09, Word8
0x0A, Word8
0x16, Word8
0x17, Word8
0x18, Word8
0x19, Word8
0x1A, Word8
0x25, Word8
0x26, Word8
0x27, Word8
0x28, Word8
0x29, Word8
0x2A, Word8
0x34, Word8
0x35
      ,Word8
0x36, Word8
0x37, Word8
0x38, Word8
0x39, Word8
0x3A, Word8
0x43, Word8
0x44, Word8
0x45, Word8
0x46, Word8
0x47, Word8
0x48, Word8
0x49, Word8
0x4A, Word8
0x53, Word8
0x54
      ,Word8
0x55, Word8
0x56, Word8
0x57, Word8
0x58, Word8
0x59, Word8
0x5A, Word8
0x63, Word8
0x64, Word8
0x65, Word8
0x66, Word8
0x67, Word8
0x68, Word8
0x69, Word8
0x6A, Word8
0x73
      ,Word8
0x74, Word8
0x75, Word8
0x76, Word8
0x77, Word8
0x78, Word8
0x79, Word8
0x7A, Word8
0x83, Word8
0x84, Word8
0x85, Word8
0x86, Word8
0x87, Word8
0x88, Word8
0x89, Word8
0x8A
      ,Word8
0x92, Word8
0x93, Word8
0x94, Word8
0x95, Word8
0x96, Word8
0x97, Word8
0x98, Word8
0x99, Word8
0x9A, Word8
0xA2, Word8
0xA3, Word8
0xA4, Word8
0xA5, Word8
0xA6, Word8
0xA7
      ,Word8
0xA8, Word8
0xA9, Word8
0xAA, Word8
0xB2, Word8
0xB3, Word8
0xB4, Word8
0xB5, Word8
0xB6, Word8
0xB7, Word8
0xB8, Word8
0xB9, Word8
0xBA, Word8
0xC2, Word8
0xC3, Word8
0xC4
      ,Word8
0xC5, Word8
0xC6, Word8
0xC7, Word8
0xC8, Word8
0xC9, Word8
0xCA, Word8
0xD2, Word8
0xD3, Word8
0xD4, Word8
0xD5, Word8
0xD6, Word8
0xD7, Word8
0xD8, Word8
0xD9, Word8
0xDA
      ,Word8
0xE1, Word8
0xE2, Word8
0xE3, Word8
0xE4, Word8
0xE5, Word8
0xE6, Word8
0xE7, Word8
0xE8, Word8
0xE9, Word8
0xEA, Word8
0xF1, Word8
0xF2, Word8
0xF3, Word8
0xF4, Word8
0xF5
      ,Word8
0xF6, Word8
0xF7, Word8
0xF8, Word8
0xF9, Word8
0xFA]
    ]

type HuffmanTable = [[Word8]]

defaultAcChromaHuffmanTree :: HuffmanTree
defaultAcChromaHuffmanTree :: HuffmanTree
defaultAcChromaHuffmanTree = [[Word8]] -> HuffmanTree
buildHuffmanTree [[Word8]]
defaultAcChromaHuffmanTable 

defaultAcChromaHuffmanTable :: HuffmanTable
defaultAcChromaHuffmanTable :: [[Word8]]
defaultAcChromaHuffmanTable = 
    [ []
    , [Word8
0x00, Word8
0x01]
    , [Word8
0x02]
    , [Word8
0x03, Word8
0x11]
    , [Word8
0x04, Word8
0x05, Word8
0x21, Word8
0x31]
    , [Word8
0x06, Word8
0x12, Word8
0x41, Word8
0x51]
    , [Word8
0x07, Word8
0x61, Word8
0x71]
    , [Word8
0x13, Word8
0x22, Word8
0x32, Word8
0x81]
    , [Word8
0x08, Word8
0x14, Word8
0x42, Word8
0x91, Word8
0xA1, Word8
0xB1, Word8
0xC1]
    , [Word8
0x09, Word8
0x23, Word8
0x33, Word8
0x52, Word8
0xF0]
    , [Word8
0x15, Word8
0x62, Word8
0x72, Word8
0xD1]
    , [Word8
0x0A, Word8
0x16, Word8
0x24, Word8
0x34]
    , []
    , [Word8
0xE1]
    , [Word8
0x25, Word8
0xF1]
    , [ Word8
0x17, Word8
0x18, Word8
0x19, Word8
0x1A, Word8
0x26, Word8
0x27, Word8
0x28, Word8
0x29, Word8
0x2A, Word8
0x35
      , Word8
0x36, Word8
0x37, Word8
0x38, Word8
0x39, Word8
0x3A, Word8
0x43, Word8
0x44, Word8
0x45, Word8
0x46, Word8
0x47
      , Word8
0x48, Word8
0x49, Word8
0x4A, Word8
0x53, Word8
0x54, Word8
0x55, Word8
0x56, Word8
0x57, Word8
0x58, Word8
0x59
      , Word8
0x5A, Word8
0x63, Word8
0x64, Word8
0x65, Word8
0x66, Word8
0x67, Word8
0x68, Word8
0x69, Word8
0x6A, Word8
0x73
      , Word8
0x74, Word8
0x75, Word8
0x76, Word8
0x77, Word8
0x78, Word8
0x79, Word8
0x7A, Word8
0x82, Word8
0x83, Word8
0x84
      , Word8
0x85, Word8
0x86, Word8
0x87, Word8
0x88, Word8
0x89, Word8
0x8A, Word8
0x92, Word8
0x93, Word8
0x94, Word8
0x95
      , Word8
0x96, Word8
0x97, Word8
0x98, Word8
0x99, Word8
0x9A, Word8
0xA2, Word8
0xA3, Word8
0xA4, Word8
0xA5, Word8
0xA6
      , Word8
0xA7, Word8
0xA8, Word8
0xA9, Word8
0xAA, Word8
0xB2, Word8
0xB3, Word8
0xB4, Word8
0xB5, Word8
0xB6, Word8
0xB7
      , Word8
0xB8, Word8
0xB9, Word8
0xBA, Word8
0xC2, Word8
0xC3, Word8
0xC4, Word8
0xC5, Word8
0xC6, Word8
0xC7, Word8
0xC8
      , Word8
0xC9, Word8
0xCA, Word8
0xD2, Word8
0xD3, Word8
0xD4, Word8
0xD5, Word8
0xD6, Word8
0xD7, Word8
0xD8, Word8
0xD9
      , Word8
0xDA, Word8
0xE2, Word8
0xE3, Word8
0xE4, Word8
0xE5, Word8
0xE6, Word8
0xE7, Word8
0xE8, Word8
0xE9, Word8
0xEA
      , Word8
0xF2, Word8
0xF3, Word8
0xF4, Word8
0xF5, Word8
0xF6, Word8
0xF7, Word8
0xF8, Word8
0xF9, Word8
0xFA
      ]
    ]