{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE CPP #-}
module Codec.Picture.Jpg.Internal.Common
    ( DctCoefficients
    , JpgUnpackerParameter( .. )
    , decodeInt
    , dcCoefficientDecode
    , deQuantize
    , decodeRrrrSsss
    , zigZagReorderForward 
    , zigZagReorderForwardv
    , zigZagReorder
    , inverseDirectCosineTransform
    , unpackInt
    , unpackMacroBlock
    , rasterMap
    , decodeMacroBlock
    , decodeRestartInterval
    , toBlockSize
    ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative( pure, (<$>) )
#endif

import Control.Monad( when )
import Control.Monad.ST( ST, runST )
import Data.Bits( unsafeShiftL, unsafeShiftR, (.&.) )
import Data.Int( Int16, Int32 )
import Data.Maybe( fromMaybe )
import Data.Word( Word8 )
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Storable.Mutable as M
import Foreign.Storable ( Storable )

import Codec.Picture.Types
import Codec.Picture.BitWriter
import Codec.Picture.Jpg.Internal.Types
import Codec.Picture.Jpg.Internal.FastIdct
import Codec.Picture.Jpg.Internal.DefaultTable

-- | Same as for DcCoefficient, to provide nicer type signatures

type DctCoefficients = DcCoefficient

data JpgUnpackerParameter = JpgUnpackerParameter
    { JpgUnpackerParameter -> HuffmanPackedTree
dcHuffmanTree        :: !HuffmanPackedTree
    , JpgUnpackerParameter -> HuffmanPackedTree
acHuffmanTree        :: !HuffmanPackedTree
    , JpgUnpackerParameter -> Int
componentIndex       :: {-# UNPACK #-} !Int
    , JpgUnpackerParameter -> Int
restartInterval      :: {-# UNPACK #-} !Int
    , JpgUnpackerParameter -> Int
componentWidth       :: {-# UNPACK #-} !Int
    , JpgUnpackerParameter -> Int
componentHeight      :: {-# UNPACK #-} !Int
    , JpgUnpackerParameter -> (Int, Int)
subSampling          :: !(Int, Int)
    , JpgUnpackerParameter -> (Int, Int)
coefficientRange     :: !(Int, Int)
    , JpgUnpackerParameter -> (Int, Int)
successiveApprox     :: !(Int, Int)
    , JpgUnpackerParameter -> Int
readerIndex          :: {-# UNPACK #-} !Int
      -- | When in progressive mode, we can have many

      -- color in a scan or only one. The indices changes

      -- on this fact, when mixed, there is whole 

      -- MCU for all color components, spanning multiple

      -- block lines. With only one color component we use

      -- the normal raster order.

    , JpgUnpackerParameter -> Int
indiceVector         :: {-# UNPACK #-} !Int
    , JpgUnpackerParameter -> Int
blockIndex           :: {-# UNPACK #-} !Int
    , JpgUnpackerParameter -> Int
blockMcuX            :: {-# UNPACK #-} !Int
    , JpgUnpackerParameter -> Int
blockMcuY            :: {-# UNPACK #-} !Int
    }
    deriving Int -> JpgUnpackerParameter -> ShowS
[JpgUnpackerParameter] -> ShowS
JpgUnpackerParameter -> String
(Int -> JpgUnpackerParameter -> ShowS)
-> (JpgUnpackerParameter -> String)
-> ([JpgUnpackerParameter] -> ShowS)
-> Show JpgUnpackerParameter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JpgUnpackerParameter -> ShowS
showsPrec :: Int -> JpgUnpackerParameter -> ShowS
$cshow :: JpgUnpackerParameter -> String
show :: JpgUnpackerParameter -> String
$cshowList :: [JpgUnpackerParameter] -> ShowS
showList :: [JpgUnpackerParameter] -> ShowS
Show

toBlockSize :: Int -> Int
toBlockSize :: Int -> Int
toBlockSize Int
v = (Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8

decodeRestartInterval :: BoolReader s Int32
decodeRestartInterval :: forall s. BoolReader s Int32
decodeRestartInterval = Int32 -> StateT BoolState (ST s) Int32
forall a. a -> StateT BoolState (ST s) a
forall (m :: * -> *) a. Monad m => a -> m a
return (-Int32
1) {-  do
  bits <- replicateM 8 getNextBitJpg
  if bits == replicate 8 True
     then do
         marker <- replicateM 8 getNextBitJpg
         return $ packInt marker
     else return (-1)
        -}

{-# INLINE decodeInt #-}
decodeInt :: Int -> BoolReader s Int32
decodeInt :: forall s. Int -> BoolReader s Int32
decodeInt Int
ssss = do
    Bool
signBit <- BoolReader s Bool
forall s. BoolReader s Bool
getNextBitJpg
    let dataRange :: Int32
dataRange = Int32
1 Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
ssss Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        leftBitCount :: Int
leftBitCount = Int
ssss Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    -- First following bits store the sign of the coefficient, and counted in

    -- SSSS, so the bit count for the int, is ssss - 1

    if Bool
signBit
       then (\Int32
w -> Int32
dataRange Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
w) (Int32 -> Int32) -> BoolReader s Int32 -> BoolReader s Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> BoolReader s Int32
forall s. Int -> BoolReader s Int32
unpackInt Int
leftBitCount
       else (\Int32
w -> Int32
1 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
dataRange Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
2 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
w) (Int32 -> Int32) -> BoolReader s Int32 -> BoolReader s Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> BoolReader s Int32
forall s. Int -> BoolReader s Int32
unpackInt Int
leftBitCount

decodeRrrrSsss :: HuffmanPackedTree -> BoolReader s (Int, Int)
decodeRrrrSsss :: forall s. HuffmanPackedTree -> BoolReader s (Int, Int)
decodeRrrrSsss HuffmanPackedTree
tree = do
    Word8
rrrrssss <- HuffmanPackedTree -> BoolReader s Word8
forall s. HuffmanPackedTree -> BoolReader s Word8
huffmanPackedDecode HuffmanPackedTree
tree
    let rrrr :: Word8
rrrr = (Word8
rrrrssss Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
4) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xF
        ssss :: Word8
ssss =  Word8
rrrrssss Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xF
    (Int, Int) -> BoolReader s (Int, Int)
forall a. a -> StateT BoolState (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
rrrr, Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
ssss)

dcCoefficientDecode :: HuffmanPackedTree -> BoolReader s DcCoefficient
dcCoefficientDecode :: forall s. HuffmanPackedTree -> BoolReader s Int16
dcCoefficientDecode HuffmanPackedTree
dcTree = do
    Word8
ssss <- HuffmanPackedTree -> BoolReader s Word8
forall s. HuffmanPackedTree -> BoolReader s Word8
huffmanPackedDecode HuffmanPackedTree
dcTree
    if Word8
ssss Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0
       then Int16 -> BoolReader s Int16
forall a. a -> StateT BoolState (ST s) a
forall (m :: * -> *) a. Monad m => a -> m a
return Int16
0
       else Int32 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int16)
-> StateT BoolState (ST s) Int32 -> BoolReader s Int16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT BoolState (ST s) Int32
forall s. Int -> BoolReader s Int32
decodeInt (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
ssss)

-- | Apply a quantization matrix to a macroblock

{-# INLINE deQuantize #-}
deQuantize :: MacroBlock Int16 -> MutableMacroBlock s Int16
           -> ST s (MutableMacroBlock s Int16)
deQuantize :: forall s.
MacroBlock Int16
-> MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16)
deQuantize MacroBlock Int16
table MutableMacroBlock s Int16
block = Int -> ST s (MutableMacroBlock s Int16)
update Int
0
    where update :: Int -> ST s (MutableMacroBlock s Int16)
update Int
64 = MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MutableMacroBlock s Int16
block
          update Int
i = do
              Int16
val <- MutableMacroBlock s Int16
MVector (PrimState (ST s)) Int16
block MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.unsafeRead` Int
i
              let finalValue :: Int16
finalValue = Int16
val Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
* (MacroBlock Int16
table MacroBlock Int16 -> Int -> Int16
forall a. Storable a => Vector a -> Int -> a
`VS.unsafeIndex` Int
i)
              (MutableMacroBlock s Int16
MVector (PrimState (ST s)) Int16
block MVector (PrimState (ST s)) Int16 -> Int -> Int16 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` Int
i) Int16
finalValue
              Int -> ST s (MutableMacroBlock s Int16)
update (Int -> ST s (MutableMacroBlock s Int16))
-> Int -> ST s (MutableMacroBlock s Int16)
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

inverseDirectCosineTransform :: MutableMacroBlock s Int16
                             -> ST s (MutableMacroBlock s Int16)
inverseDirectCosineTransform :: forall s.
MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16)
inverseDirectCosineTransform MutableMacroBlock s Int16
mBlock =
    MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16)
forall s.
MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16)
fastIdct MutableMacroBlock s Int16
mBlock ST s (MutableMacroBlock s Int16)
-> (MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16))
-> ST s (MutableMacroBlock s Int16)
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
>>= MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16)
forall s.
MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16)
mutableLevelShift

zigZagOrder :: MacroBlock Int
zigZagOrder :: MacroBlock Int
zigZagOrder = [Int] -> MacroBlock Int
forall a. Storable a => [a] -> MacroBlock a
makeMacroBlock ([Int] -> MacroBlock Int) -> [Int] -> MacroBlock Int
forall a b. (a -> b) -> a -> b
$ [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [[ Int
0, Int
1, Int
5, Int
6,Int
14,Int
15,Int
27,Int
28]
    ,[ Int
2, Int
4, Int
7,Int
13,Int
16,Int
26,Int
29,Int
42]
    ,[ Int
3, Int
8,Int
12,Int
17,Int
25,Int
30,Int
41,Int
43]
    ,[ Int
9,Int
11,Int
18,Int
24,Int
31,Int
40,Int
44,Int
53]
    ,[Int
10,Int
19,Int
23,Int
32,Int
39,Int
45,Int
52,Int
54]
    ,[Int
20,Int
22,Int
33,Int
38,Int
46,Int
51,Int
55,Int
60]
    ,[Int
21,Int
34,Int
37,Int
47,Int
50,Int
56,Int
59,Int
61]
    ,[Int
35,Int
36,Int
48,Int
49,Int
57,Int
58,Int
62,Int
63]
    ]

zigZagReorderForwardv :: (Storable a, Num a) => VS.Vector a -> VS.Vector a
zigZagReorderForwardv :: forall a. (Storable a, Num a) => Vector a -> Vector a
zigZagReorderForwardv Vector a
vec = (forall s. ST s (Vector a)) -> Vector a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Vector a)) -> Vector a)
-> (forall s. ST s (Vector a)) -> Vector a
forall a b. (a -> b) -> a -> b
$ do
    MutableMacroBlock s a
v <- Int -> ST s (MVector (PrimState (ST s)) a)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
M.new Int
64
    MutableMacroBlock s a
mv <- Vector a -> ST s (MVector (PrimState (ST s)) a)
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
Vector a -> m (MVector (PrimState m) a)
VS.thaw Vector a
vec
    MutableMacroBlock s a
-> MutableMacroBlock s a -> ST s (MutableMacroBlock s a)
forall a s.
Storable a =>
MutableMacroBlock s a
-> MutableMacroBlock s a -> ST s (MutableMacroBlock s a)
zigZagReorderForward MutableMacroBlock s a
v MutableMacroBlock s a
mv ST s (MutableMacroBlock s a)
-> (MutableMacroBlock s a -> ST s (Vector a)) -> ST s (Vector a)
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
>>= MutableMacroBlock s a -> ST s (Vector a)
MVector (PrimState (ST s)) a -> ST s (Vector a)
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
VS.freeze

zigZagOrderForward :: MacroBlock Int
zigZagOrderForward :: MacroBlock Int
zigZagOrderForward = Int -> (Int -> Int) -> MacroBlock Int
forall a. Storable a => Int -> (Int -> a) -> Vector a
VS.generate Int
64 Int -> Int
inv
  where inv :: Int -> Int
inv Int
i = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> MacroBlock Int -> Maybe Int
forall a. Storable a => (a -> Bool) -> Vector a -> Maybe Int
VS.findIndex (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==) MacroBlock Int
zigZagOrder

zigZagReorderForward :: (Storable a)
                     => MutableMacroBlock s a
                     -> MutableMacroBlock s a
                     -> ST s (MutableMacroBlock s a)
{-# SPECIALIZE INLINE zigZagReorderForward :: MutableMacroBlock s Int32
                                           -> MutableMacroBlock s Int32
                                           -> ST s (MutableMacroBlock s Int32) #-}
{-# SPECIALIZE INLINE zigZagReorderForward :: MutableMacroBlock s Int16
                                           -> MutableMacroBlock s Int16
                                           -> ST s (MutableMacroBlock s Int16) #-}
{-# SPECIALIZE INLINE zigZagReorderForward :: MutableMacroBlock s Word8
                                           -> MutableMacroBlock s Word8
                                           -> ST s (MutableMacroBlock s Word8) #-}
zigZagReorderForward :: forall a s.
Storable a =>
MutableMacroBlock s a
-> MutableMacroBlock s a -> ST s (MutableMacroBlock s a)
zigZagReorderForward MutableMacroBlock s a
zigzaged MutableMacroBlock s a
block = MacroBlock Int -> ST s ()
ordering MacroBlock Int
zigZagOrderForward ST s ()
-> ST s (MutableMacroBlock s a) -> ST s (MutableMacroBlock s a)
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MutableMacroBlock s a -> ST s (MutableMacroBlock s a)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MutableMacroBlock s a
zigzaged
  where ordering :: MacroBlock Int -> ST s ()
ordering !MacroBlock Int
table = Int -> ST s ()
reorder (Int
0 :: Int)
          where reorder :: Int -> ST s ()
reorder !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
64 = () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                reorder Int
i  = do
                     let idx :: Int
idx = MacroBlock Int
table MacroBlock Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
`VS.unsafeIndex` Int
i
                     a
v <- MutableMacroBlock s a
MVector (PrimState (ST s)) a
block MVector (PrimState (ST s)) a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.unsafeRead` Int
idx
                     (MutableMacroBlock s a
MVector (PrimState (ST s)) a
zigzaged MVector (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` Int
i) a
v
                     Int -> ST s ()
reorder (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

zigZagReorder :: MutableMacroBlock s Int16 -> MutableMacroBlock s Int16
              -> ST s (MutableMacroBlock s Int16)
zigZagReorder :: forall s.
MutableMacroBlock s Int16
-> MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16)
zigZagReorder MutableMacroBlock s Int16
zigzaged MutableMacroBlock s Int16
block = do
    let update :: Int -> ST s ()
update Int
i =  do
            let idx :: Int
idx = MacroBlock Int
zigZagOrder MacroBlock Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
`VS.unsafeIndex` Int
i
            Int16
v <- MutableMacroBlock s Int16
MVector (PrimState (ST s)) Int16
block MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.unsafeRead` Int
idx
            (MutableMacroBlock s Int16
MVector (PrimState (ST s)) Int16
zigzaged MVector (PrimState (ST s)) Int16 -> Int -> Int16 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` Int
i) Int16
v

        reorder :: Int -> ST s ()
reorder Int
63 = Int -> ST s ()
update Int
63
        reorder Int
i  = Int -> ST s ()
update Int
i ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s ()
reorder (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

    Int -> ST s ()
reorder (Int
0 :: Int)
    MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MutableMacroBlock s Int16
zigzaged

-- | Unpack an int of the given size encoded from MSB to LSB.

unpackInt :: Int -> BoolReader s Int32
unpackInt :: forall s. Int -> BoolReader s Int32
unpackInt = Int -> BoolReader s Int32
forall s. Int -> BoolReader s Int32
getNextIntJpg

{-# INLINE rasterMap #-}
rasterMap :: (Monad m)
          => Int -> Int -> (Int -> Int -> m ())
          -> m ()
rasterMap :: forall (m :: * -> *).
Monad m =>
Int -> Int -> (Int -> Int -> m ()) -> m ()
rasterMap Int
width Int
height Int -> Int -> m ()
f = Int -> m ()
liner Int
0
  where liner :: Int -> m ()
liner Int
y | Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
height = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        liner Int
y = Int -> m ()
columner Int
0
          where columner :: Int -> m ()
columner Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
width = Int -> m ()
liner (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                columner Int
x = Int -> Int -> m ()
f Int
x Int
y m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> m ()
columner (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

pixelClamp :: Int16 -> Word8
pixelClamp :: Int16 -> Word8
pixelClamp Int16
n = Int16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Word8) -> (Int16 -> Int16) -> Int16 -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int16 -> Int16
forall a. Ord a => a -> a -> a
min Int16
255 (Int16 -> Word8) -> Int16 -> Word8
forall a b. (a -> b) -> a -> b
$ Int16 -> Int16 -> Int16
forall a. Ord a => a -> a -> a
max Int16
0 Int16
n

-- | Given a size coefficient (how much a pixel span horizontally

-- and vertically), the position of the macroblock, return a list

-- of indices and value to be stored in an array (like the final

-- image)

unpackMacroBlock :: Int    -- ^ Component count

                 -> Int -- ^ Width coefficient

                 -> Int -- ^ Height coefficient

                 -> Int -- ^ Component index

                 -> Int -- ^ x

                 -> Int -- ^ y

                 -> MutableImage s PixelYCbCr8
                 -> MutableMacroBlock s Int16
                 -> ST s ()
unpackMacroBlock :: forall s.
Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> MutableImage s PixelYCbCr8
-> MutableMacroBlock s Int16
-> ST s ()
unpackMacroBlock Int
compCount Int
wCoeff Int
hCoeff Int
compIdx Int
x Int
y
                 (MutableImage { mutableImageWidth :: forall s a. MutableImage s a -> Int
mutableImageWidth = Int
imgWidth,
                                 mutableImageHeight :: forall s a. MutableImage s a -> Int
mutableImageHeight = Int
imgHeight, mutableImageData :: forall s a. MutableImage s a -> STVector s (PixelBaseComponent a)
mutableImageData = STVector s (PixelBaseComponent PixelYCbCr8)
img })
                 MutableMacroBlock s Int16
block = Int -> Int -> (Int -> Int -> ST s ()) -> ST s ()
forall (m :: * -> *).
Monad m =>
Int -> Int -> (Int -> Int -> m ()) -> m ()
rasterMap Int
forall a. Num a => a
dctBlockSize Int
forall a. Num a => a
dctBlockSize Int -> Int -> ST s ()
unpacker
  where unpacker :: Int -> Int -> ST s ()
unpacker Int
i Int
j = do
          let yBase :: Int
yBase = Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
forall a. Num a => a
dctBlockSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
hCoeff
          Word8
compVal <- Int16 -> Word8
pixelClamp (Int16 -> Word8) -> ST s Int16 -> ST s Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutableMacroBlock s Int16
MVector (PrimState (ST s)) Int16
block MVector (PrimState (ST s)) Int16 -> Int -> ST s Int16
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`M.unsafeRead` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
forall a. Num a => a
dctBlockSize))
          Int -> Int -> (Int -> Int -> ST s ()) -> ST s ()
forall (m :: * -> *).
Monad m =>
Int -> Int -> (Int -> Int -> m ()) -> m ()
rasterMap Int
wCoeff Int
hCoeff ((Int -> Int -> ST s ()) -> ST s ())
-> (Int -> Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
wDup Int
hDup -> do
             let xBase :: Int
xBase = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
forall a. Num a => a
dctBlockSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
wCoeff
                 xPos :: Int
xPos = Int
xBase Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wDup
                 yPos :: Int
yPos = Int
yBase Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hDup

             Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
xPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
imgWidth Bool -> Bool -> Bool
&& Int
yPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
imgHeight)
                  (do let mutableIdx :: Int
mutableIdx = (Int
xPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
yPos Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
imgWidth) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
compCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
compIdx
                      (STVector s (PixelBaseComponent PixelYCbCr8)
MVector (PrimState (ST s)) Word8
img MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
`M.unsafeWrite` Int
mutableIdx) Word8
compVal)

-- | This is one of the most important function of the decoding,

-- it form the barebone decoding pipeline for macroblock. It's all

-- there is to know for macro block transformation

decodeMacroBlock :: MacroBlock DctCoefficients
                 -> MutableMacroBlock s Int16
                 -> MutableMacroBlock s Int16
                 -> ST s (MutableMacroBlock s Int16)
decodeMacroBlock :: forall s.
MacroBlock Int16
-> MutableMacroBlock s Int16
-> MutableMacroBlock s Int16
-> ST s (MutableMacroBlock s Int16)
decodeMacroBlock MacroBlock Int16
quantizationTable MutableMacroBlock s Int16
zigZagBlock MutableMacroBlock s Int16
block =
    MacroBlock Int16
-> MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16)
forall s.
MacroBlock Int16
-> MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16)
deQuantize MacroBlock Int16
quantizationTable MutableMacroBlock s Int16
block ST s (MutableMacroBlock s Int16)
-> (MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16))
-> ST s (MutableMacroBlock s Int16)
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
>>= MutableMacroBlock s Int16
-> MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16)
forall s.
MutableMacroBlock s Int16
-> MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16)
zigZagReorder MutableMacroBlock s Int16
zigZagBlock
                                       ST s (MutableMacroBlock s Int16)
-> (MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16))
-> ST s (MutableMacroBlock s Int16)
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
>>= MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16)
forall s.
MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16)
inverseDirectCosineTransform