{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
module Codec.Picture.Jpg.Internal.Progressive
    ( JpgUnpackerParameter( .. )
    , progressiveUnpack
    ) where

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

import Control.Monad( when, unless, forM_ )
import Control.Monad.ST( ST )
import Control.Monad.Trans( lift )
import Data.Bits( (.&.), (.|.), unsafeShiftL )
import Data.Int( Int16, Int32 )
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.Vector as V
import qualified Data.Vector.Storable as VS
import Data.Vector( (!) )
import qualified Data.Vector.Mutable as M
import qualified Data.Vector.Storable.Mutable as MS

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

createMcuLineIndices :: JpgComponent -> Int -> Int -> V.Vector (VS.Vector Int)
createMcuLineIndices :: JpgComponent -> Int -> Int -> Vector (Vector Int)
createMcuLineIndices JpgComponent
param Int
imgWidth Int
mcuWidth =
 [Vector Int] -> Vector (Vector Int)
forall a. [a] -> Vector a
V.fromList ([Vector Int] -> Vector (Vector Int))
-> [Vector Int] -> Vector (Vector Int)
forall a b. (a -> b) -> a -> b
$ [Int] -> Vector Int
forall a. Storable a => [a] -> Vector a
VS.fromList ([Int] -> Vector Int) -> [[Int]] -> [Vector Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Int]
indexSolo, [Int]
indexMulti]
  where compW :: Int
compW = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ JpgComponent -> Word8
horizontalSamplingFactor JpgComponent
param
        compH :: Int
compH = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ JpgComponent -> Word8
verticalSamplingFactor JpgComponent
param
        imageBlockSize :: Int
imageBlockSize = Int -> Int
toBlockSize Int
imgWidth

        -- if the displayed MCU block is only displayed in half (like with

        -- width 500 then we loose one macroblock of the MCU at the end of

        -- the line. Previous implementation which naively used full mcu

        -- was wrong. Only taking into account visible macroblocks

        indexSolo :: [Int]
indexSolo = [Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
            | Int
y <- [Int
0 .. Int
compH Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
            , let base :: Int
base = Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mcuWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
compW
            , Int
x <- [Int
0 .. Int
imageBlockSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

        indexMulti :: [Int]
indexMulti =
            [(Int
mcu Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mcuWidth) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
compW Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
                | Int
mcu <- [Int
0 .. Int
mcuWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                , Int
y <- [Int
0 .. Int
compH Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                , Int
x <- [Int
0 .. Int
compW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ]

decodeFirstDC :: JpgUnpackerParameter
              -> MS.STVector s Int16
              -> MutableMacroBlock s Int16
              -> Int32
              -> BoolReader s Int32
decodeFirstDC :: forall s.
JpgUnpackerParameter
-> STVector s Int16
-> STVector s Int16
-> Int32
-> BoolReader s Int32
decodeFirstDC JpgUnpackerParameter
params STVector s Int16
dcCoeffs STVector s Int16
block Int32
eobrun = StateT BoolState (ST s) ()
unpack StateT BoolState (ST s) ()
-> StateT BoolState (ST s) Int32 -> StateT BoolState (ST s) Int32
forall a b.
StateT BoolState (ST s) a
-> StateT BoolState (ST s) b -> StateT BoolState (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int32 -> StateT BoolState (ST s) Int32
forall a. a -> StateT BoolState (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
eobrun
  where unpack :: StateT BoolState (ST s) ()
unpack = do
          (dcDeltaCoefficient) <- HuffmanPackedTree -> BoolReader s Int16
forall s. HuffmanPackedTree -> BoolReader s Int16
dcCoefficientDecode (HuffmanPackedTree -> BoolReader s Int16)
-> HuffmanPackedTree -> BoolReader s Int16
forall a b. (a -> b) -> a -> b
$ JpgUnpackerParameter -> HuffmanPackedTree
dcHuffmanTree JpgUnpackerParameter
params
          previousDc <- lift $ dcCoeffs `MS.unsafeRead` componentIndex params
          let neoDcCoefficient = Int16
previousDc Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+ Int16
dcDeltaCoefficient
              approxLow = (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ JpgUnpackerParameter -> (Int, Int)
successiveApprox JpgUnpackerParameter
params
              scaledDc = Int16
neoDcCoefficient Int16 -> Int -> Int16
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
approxLow
          lift $ (block `MS.unsafeWrite` 0) scaledDc 
          lift $ (dcCoeffs `MS.unsafeWrite` componentIndex params) neoDcCoefficient

decodeRefineDc :: JpgUnpackerParameter
               -> a
               -> MutableMacroBlock s Int16
               -> Int32
               -> BoolReader s Int32
decodeRefineDc :: forall a s.
JpgUnpackerParameter
-> a -> MutableMacroBlock s Int16 -> Int32 -> BoolReader s Int32
decodeRefineDc JpgUnpackerParameter
params a
_ MutableMacroBlock s Int16
block Int32
eobrun = StateT BoolState (ST s) ()
unpack StateT BoolState (ST s) ()
-> StateT BoolState (ST s) Int32 -> StateT BoolState (ST s) Int32
forall a b.
StateT BoolState (ST s) a
-> StateT BoolState (ST s) b -> StateT BoolState (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int32 -> StateT BoolState (ST s) Int32
forall a. a -> StateT BoolState (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
eobrun
  where approxLow :: Int
approxLow = (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ JpgUnpackerParameter -> (Int, Int)
successiveApprox JpgUnpackerParameter
params
        plusOne :: Int16
plusOne = Int16
1 Int16 -> Int -> Int16
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
approxLow
        unpack :: StateT BoolState (ST s) ()
unpack = do
            bit <- BoolReader s Bool
forall s. BoolReader s Bool
getNextBitJpg
            when bit . lift $ do
                v <- block `MS.unsafeRead` 0
                (block `MS.unsafeWrite` 0) $ v .|. plusOne

decodeFirstAc :: JpgUnpackerParameter
              -> a
              -> MutableMacroBlock s Int16
              -> Int32
              -> BoolReader s Int32
decodeFirstAc :: forall a s.
JpgUnpackerParameter
-> a -> MutableMacroBlock s Int16 -> Int32 -> BoolReader s Int32
decodeFirstAc JpgUnpackerParameter
_params a
_ MutableMacroBlock s Int16
_block Int32
eobrun | Int32
eobrun Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
0 = Int32 -> StateT BoolState (ST s) Int32
forall a. a -> StateT BoolState (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int32 -> StateT BoolState (ST s) Int32)
-> Int32 -> StateT BoolState (ST s) Int32
forall a b. (a -> b) -> a -> b
$ Int32
eobrun Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
1
decodeFirstAc JpgUnpackerParameter
params a
_ MutableMacroBlock s Int16
block Int32
_ = Int -> StateT BoolState (ST s) Int32
unpack Int
startIndex
  where (Int
startIndex, Int
maxIndex) = JpgUnpackerParameter -> (Int, Int)
coefficientRange JpgUnpackerParameter
params
        (Int
low, Int
_) = JpgUnpackerParameter -> (Int, Int)
successiveApprox JpgUnpackerParameter
params
        unpack :: Int -> StateT BoolState (ST s) Int32
unpack Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxIndex = Int32 -> StateT BoolState (ST s) Int32
forall a. a -> StateT BoolState (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
0
        unpack Int
n = do
            rrrrssss <- HuffmanPackedTree -> BoolReader s (Int, Int)
forall s. HuffmanPackedTree -> BoolReader s (Int, Int)
decodeRrrrSsss (HuffmanPackedTree -> BoolReader s (Int, Int))
-> HuffmanPackedTree -> BoolReader s (Int, Int)
forall a b. (a -> b) -> a -> b
$ JpgUnpackerParameter -> HuffmanPackedTree
acHuffmanTree JpgUnpackerParameter
params
            case rrrrssss of
                (Int
0xF, Int
0) -> Int -> StateT BoolState (ST s) Int32
unpack (Int -> StateT BoolState (ST s) Int32)
-> Int -> StateT BoolState (ST s) Int32
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16
                (  Int
0, Int
0) -> Int32 -> StateT BoolState (ST s) Int32
forall a. a -> StateT BoolState (ST s) a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
0
                (  Int
r, Int
0) -> Int32 -> Int32
forall {a}. (Bits a, Num a) => a -> a
eobrun (Int32 -> Int32)
-> StateT BoolState (ST s) Int32 -> StateT BoolState (ST s) Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT BoolState (ST s) Int32
forall s. Int -> BoolReader s Int32
unpackInt Int
r
                    where eobrun :: a -> a
eobrun a
lowBits = (a
1 a -> Int -> a
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
r) a -> a -> a
forall a. Num a => a -> a -> a
- a
1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
lowBits
                (  Int
r, Int
s) -> do
                    let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r
                    val <- (Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
low) (Int32 -> Int32)
-> StateT BoolState (ST s) Int32 -> StateT BoolState (ST s) Int32
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 Int
s
                    lift . (block `MS.unsafeWrite` n') $ fromIntegral val
                    unpack $ n' + 1

decodeRefineAc :: forall a s. JpgUnpackerParameter
               -> a
               -> MutableMacroBlock s Int16
               -> Int32
               -> BoolReader s Int32
decodeRefineAc :: forall a s.
JpgUnpackerParameter
-> a -> MutableMacroBlock s Int16 -> Int32 -> BoolReader s Int32
decodeRefineAc JpgUnpackerParameter
params a
_ MutableMacroBlock s Int16
block Int32
eobrun
        | Int32
eobrun Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
0 = Int -> StateT BoolState (ST s) Int32
unpack Int
startIndex
        | Bool
otherwise   = Int -> StateT BoolState (ST s) ()
performEobRun Int
startIndex StateT BoolState (ST s) ()
-> StateT BoolState (ST s) Int32 -> StateT BoolState (ST s) Int32
forall a b.
StateT BoolState (ST s) a
-> StateT BoolState (ST s) b -> StateT BoolState (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int32 -> StateT BoolState (ST s) Int32
forall a. a -> StateT BoolState (ST s) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
eobrun Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
1)
  where (Int
startIndex, Int
maxIndex) = JpgUnpackerParameter -> (Int, Int)
coefficientRange JpgUnpackerParameter
params
        (Int
low, Int
_) = JpgUnpackerParameter -> (Int, Int)
successiveApprox JpgUnpackerParameter
params
        plusOne :: Int16
plusOne = Int16
1 Int16 -> Int -> Int16
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
low
        minusOne :: Int16
minusOne = (-Int16
1) Int16 -> Int -> Int16
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
low

        getBitVal :: StateT BoolState (ST s) Int16
getBitVal = do
            v <- BoolReader s Bool
forall s. BoolReader s Bool
getNextBitJpg
            pure $ if v then plusOne else minusOne

        performEobRun :: Int -> StateT BoolState (ST s) ()
performEobRun Int
idx | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxIndex = () -> StateT BoolState (ST s) ()
forall a. a -> StateT BoolState (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        performEobRun Int
idx = do
          coeff <- ST s Int16 -> StateT BoolState (ST s) Int16
forall (m :: * -> *) a. Monad m => m a -> StateT BoolState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s Int16 -> StateT BoolState (ST s) Int16)
-> ST s Int16 -> StateT BoolState (ST s) Int16
forall a b. (a -> b) -> a -> 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
`MS.unsafeRead` Int
idx
          if coeff /= 0 then do
            bit <- getNextBitJpg
            case (bit, (coeff .&. plusOne) == 0) of
               (Bool
False, Bool
_)    -> Int -> StateT BoolState (ST s) ()
performEobRun (Int -> StateT BoolState (ST s) ())
-> Int -> StateT BoolState (ST s) ()
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
               (Bool
True, Bool
False) -> Int -> StateT BoolState (ST s) ()
performEobRun (Int -> StateT BoolState (ST s) ())
-> Int -> StateT BoolState (ST s) ()
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
               (Bool
True, Bool
True) -> do
                   let newVal :: Int16
newVal | Int16
coeff Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int16
0 = Int16
coeff Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+ Int16
plusOne
                              | Bool
otherwise = Int16
coeff Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+ Int16
minusOne
                   ST s () -> StateT BoolState (ST s) ()
forall (m :: * -> *) a. Monad m => m a -> StateT BoolState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s () -> StateT BoolState (ST s) ())
-> ST s () -> StateT BoolState (ST s) ()
forall a b. (a -> b) -> a -> b
$ (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 ()
`MS.unsafeWrite` Int
idx) Int16
newVal
                   Int -> StateT BoolState (ST s) ()
performEobRun (Int -> StateT BoolState (ST s) ())
-> Int -> StateT BoolState (ST s) ()
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
          else
            performEobRun $ idx + 1

        unpack :: Int -> StateT BoolState (ST s) Int32
unpack Int
idx | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxIndex = Int32 -> StateT BoolState (ST s) Int32
forall a. a -> StateT BoolState (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
0
        unpack Int
idx = do
            rrrrssss <- HuffmanPackedTree -> BoolReader s (Int, Int)
forall s. HuffmanPackedTree -> BoolReader s (Int, Int)
decodeRrrrSsss (HuffmanPackedTree -> BoolReader s (Int, Int))
-> HuffmanPackedTree -> BoolReader s (Int, Int)
forall a b. (a -> b) -> a -> b
$ JpgUnpackerParameter -> HuffmanPackedTree
acHuffmanTree JpgUnpackerParameter
params
            case rrrrssss of
              (Int
0xF, Int
0) -> do
                idx' <- Int -> Int -> BoolReader s Int
updateCoeffs Int
0xF Int
idx
                unpack $ idx' + 1

              (  Int
r, Int
0) -> do
                  lowBits <- Int -> StateT BoolState (ST s) Int32
forall s. Int -> BoolReader s Int32
unpackInt Int
r
                  let newEobRun = (Int32
1 Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
r) Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
lowBits Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
1
                  performEobRun idx
                  pure newEobRun

              (  Int
r, Int
_) -> do
                  val <- StateT BoolState (ST s) Int16
forall {s}. StateT BoolState (ST s) Int16
getBitVal
                  idx' <- updateCoeffs (fromIntegral r) idx
                  when (idx' <= maxIndex) $
                       lift $ (block `MS.unsafeWrite` idx') val
                  unpack $ idx' + 1

        updateCoeffs :: Int -> Int -> BoolReader s Int
        updateCoeffs :: Int -> Int -> BoolReader s Int
updateCoeffs Int
r Int
idx
            | Int
r   Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0        = Int -> BoolReader s Int
forall a. a -> StateT BoolState (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> BoolReader s Int) -> Int -> BoolReader s Int
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
            | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxIndex = Int -> BoolReader s Int
forall a. a -> StateT BoolState (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
idx
        updateCoeffs Int
r Int
idx = do
          coeff <- ST s Int16 -> StateT BoolState (ST s) Int16
forall (m :: * -> *) a. Monad m => m a -> StateT BoolState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s Int16 -> StateT BoolState (ST s) Int16)
-> ST s Int16 -> StateT BoolState (ST s) Int16
forall a b. (a -> b) -> a -> 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
`MS.unsafeRead` Int
idx
          if coeff /= 0 then do
            bit <- getNextBitJpg
            when (bit && coeff .&. plusOne == 0) $ do
              let writeCoeff | Int16
coeff Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int16
0 = Int16
coeff Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+ Int16
plusOne
                             | Bool
otherwise = Int16
coeff Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+ Int16
minusOne
              lift $ (block `MS.unsafeWrite` idx) writeCoeff
            updateCoeffs r $ idx + 1
          else
            updateCoeffs (r - 1) $ idx + 1

type Unpacker s =
    JpgUnpackerParameter -> MS.STVector s Int16 -> MutableMacroBlock s Int16 -> Int32
        -> BoolReader s Int32


prepareUnpacker :: [([(JpgUnpackerParameter, a)], L.ByteString)]
                -> ST s ( V.Vector (V.Vector (JpgUnpackerParameter, Unpacker s))
                        , M.STVector s BoolState)
prepareUnpacker :: forall a s.
[([(JpgUnpackerParameter, a)], ByteString)]
-> ST
     s
     (Vector (Vector (JpgUnpackerParameter, Unpacker s)),
      STVector s BoolState)
prepareUnpacker [([(JpgUnpackerParameter, a)], ByteString)]
lst = do
    let boolStates :: Vector BoolState
boolStates = [BoolState] -> Vector BoolState
forall a. [a] -> Vector a
V.fromList ([BoolState] -> Vector BoolState)
-> [BoolState] -> Vector BoolState
forall a b. (a -> b) -> a -> b
$ ((Vector
    (JpgUnpackerParameter,
     JpgUnpackerParameter
     -> STVector (ZonkAny 0) Int16
     -> STVector (ZonkAny 0) Int16
     -> Int32
     -> BoolReader (ZonkAny 0) Int32),
  BoolState)
 -> BoolState)
-> [(Vector
       (JpgUnpackerParameter,
        JpgUnpackerParameter
        -> STVector (ZonkAny 0) Int16
        -> STVector (ZonkAny 0) Int16
        -> Int32
        -> BoolReader (ZonkAny 0) Int32),
     BoolState)]
-> [BoolState]
forall a b. (a -> b) -> [a] -> [b]
map (Vector
   (JpgUnpackerParameter,
    JpgUnpackerParameter
    -> STVector (ZonkAny 0) Int16
    -> STVector (ZonkAny 0) Int16
    -> Int32
    -> BoolReader (ZonkAny 0) Int32),
 BoolState)
-> BoolState
forall a b. (a, b) -> b
snd [(Vector
    (JpgUnpackerParameter,
     JpgUnpackerParameter
     -> STVector (ZonkAny 0) Int16
     -> STVector (ZonkAny 0) Int16
     -> Int32
     -> BoolReader (ZonkAny 0) Int32),
  BoolState)]
forall {s}.
[(Vector
    (JpgUnpackerParameter,
     JpgUnpackerParameter
     -> STVector s Int16
     -> STVector s Int16
     -> Int32
     -> BoolReader s Int32),
  BoolState)]
infos
    vec <- Vector BoolState -> ST s (MVector (PrimState (ST s)) BoolState)
forall (m :: * -> *) a.
PrimMonad m =>
Vector a -> m (MVector (PrimState m) a)
V.unsafeThaw Vector BoolState
boolStates
    return (V.fromList $ map fst infos, vec)
  where infos :: [(Vector
    (JpgUnpackerParameter,
     JpgUnpackerParameter
     -> STVector s Int16
     -> STVector s Int16
     -> Int32
     -> BoolReader s Int32),
  BoolState)]
infos = (([(JpgUnpackerParameter, a)], ByteString)
 -> (Vector
       (JpgUnpackerParameter,
        JpgUnpackerParameter
        -> STVector s Int16
        -> STVector s Int16
        -> Int32
        -> BoolReader s Int32),
     BoolState))
-> [([(JpgUnpackerParameter, a)], ByteString)]
-> [(Vector
       (JpgUnpackerParameter,
        JpgUnpackerParameter
        -> STVector s Int16
        -> STVector s Int16
        -> Int32
        -> BoolReader s Int32),
     BoolState)]
forall a b. (a -> b) -> [a] -> [b]
map ([(JpgUnpackerParameter, a)], ByteString)
-> (Vector
      (JpgUnpackerParameter,
       JpgUnpackerParameter
       -> STVector s Int16
       -> STVector s Int16
       -> Int32
       -> BoolReader s Int32),
    BoolState)
forall {b} {s}.
([(JpgUnpackerParameter, b)], ByteString)
-> (Vector
      (JpgUnpackerParameter,
       JpgUnpackerParameter
       -> STVector s Int16
       -> STVector s Int16
       -> Int32
       -> BoolReader s Int32),
    BoolState)
prepare [([(JpgUnpackerParameter, a)], ByteString)]
lst
        prepare :: ([(JpgUnpackerParameter, b)], ByteString)
-> (Vector
      (JpgUnpackerParameter,
       JpgUnpackerParameter
       -> STVector s Int16
       -> STVector s Int16
       -> Int32
       -> BoolReader s Int32),
    BoolState)
prepare ([], ByteString
_) = [Char]
-> (Vector
      (JpgUnpackerParameter,
       JpgUnpackerParameter
       -> STVector s Int16
       -> STVector s Int16
       -> Int32
       -> BoolReader s Int32),
    BoolState)
forall a. HasCallStack => [Char] -> a
error [Char]
"progressiveUnpack, no component"
        prepare (whole :: [(JpgUnpackerParameter, b)]
whole@((JpgUnpackerParameter
param, b
_) : [(JpgUnpackerParameter, b)]
_) , ByteString
byteString) =
         ([(JpgUnpackerParameter,
  JpgUnpackerParameter
  -> STVector s Int16
  -> STVector s Int16
  -> Int32
  -> BoolReader s Int32)]
-> Vector
     (JpgUnpackerParameter,
      JpgUnpackerParameter
      -> STVector s Int16
      -> STVector s Int16
      -> Int32
      -> BoolReader s Int32)
forall a. [a] -> Vector a
V.fromList ([(JpgUnpackerParameter,
   JpgUnpackerParameter
   -> STVector s Int16
   -> STVector s Int16
   -> Int32
   -> BoolReader s Int32)]
 -> Vector
      (JpgUnpackerParameter,
       JpgUnpackerParameter
       -> STVector s Int16
       -> STVector s Int16
       -> Int32
       -> BoolReader s Int32))
-> [(JpgUnpackerParameter,
     JpgUnpackerParameter
     -> STVector s Int16
     -> STVector s Int16
     -> Int32
     -> BoolReader s Int32)]
-> Vector
     (JpgUnpackerParameter,
      JpgUnpackerParameter
      -> STVector s Int16
      -> STVector s Int16
      -> Int32
      -> BoolReader s Int32)
forall a b. (a -> b) -> a -> b
$ ((JpgUnpackerParameter, b)
 -> (JpgUnpackerParameter,
     JpgUnpackerParameter
     -> STVector s Int16
     -> STVector s Int16
     -> Int32
     -> BoolReader s Int32))
-> [(JpgUnpackerParameter, b)]
-> [(JpgUnpackerParameter,
     JpgUnpackerParameter
     -> STVector s Int16
     -> STVector s Int16
     -> Int32
     -> BoolReader s Int32)]
forall a b. (a -> b) -> [a] -> [b]
map (\(JpgUnpackerParameter
p,b
_) -> (JpgUnpackerParameter
p, JpgUnpackerParameter
-> STVector s Int16
-> STVector s Int16
-> Int32
-> BoolReader s Int32
forall s.
JpgUnpackerParameter
-> STVector s Int16
-> STVector s Int16
-> Int32
-> BoolReader s Int32
unpacker)) [(JpgUnpackerParameter, b)]
whole, BoolState
boolReader)
           where unpacker :: JpgUnpackerParameter
-> STVector s Int16
-> STVector s Int16
-> Int32
-> BoolReader s Int32
unpacker = (Int, Int)
-> (Int, Int)
-> JpgUnpackerParameter
-> STVector s Int16
-> STVector s Int16
-> Int32
-> BoolReader s Int32
forall {a} {a} {a} {b} {s}.
(Eq a, Eq a, Num a, Num a) =>
(a, a)
-> (a, b)
-> JpgUnpackerParameter
-> STVector s Int16
-> STVector s Int16
-> Int32
-> BoolReader s Int32
selection (JpgUnpackerParameter -> (Int, Int)
successiveApprox JpgUnpackerParameter
param) (JpgUnpackerParameter -> (Int, Int)
coefficientRange JpgUnpackerParameter
param)
                 boolReader :: BoolState
boolReader = ByteString -> BoolState
initBoolStateJpg (ByteString -> BoolState)
-> ([ByteString] -> ByteString) -> [ByteString] -> BoolState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat ([ByteString] -> BoolState) -> [ByteString] -> BoolState
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
L.toChunks ByteString
byteString

                 selection :: (a, a)
-> (a, b)
-> JpgUnpackerParameter
-> STVector s Int16
-> STVector s Int16
-> Int32
-> BoolReader s Int32
selection (a
_, a
0) (a
0, b
_) = JpgUnpackerParameter
-> STVector s Int16
-> STVector s Int16
-> Int32
-> BoolReader s Int32
forall s.
JpgUnpackerParameter
-> STVector s Int16
-> STVector s Int16
-> Int32
-> BoolReader s Int32
decodeFirstDC
                 selection (a
_, a
0) (a, b)
_      = JpgUnpackerParameter
-> STVector s Int16
-> STVector s Int16
-> Int32
-> BoolReader s Int32
forall a s.
JpgUnpackerParameter
-> a -> MutableMacroBlock s Int16 -> Int32 -> BoolReader s Int32
decodeFirstAc
                 selection (a, a)
_      (a
0, b
_) = JpgUnpackerParameter
-> STVector s Int16
-> STVector s Int16
-> Int32
-> BoolReader s Int32
forall a s.
JpgUnpackerParameter
-> a -> MutableMacroBlock s Int16 -> Int32 -> BoolReader s Int32
decodeRefineDc
                 selection (a, a)
_      (a, b)
_      = JpgUnpackerParameter
-> STVector s Int16
-> STVector s Int16
-> Int32
-> BoolReader s Int32
forall a s.
JpgUnpackerParameter
-> a -> MutableMacroBlock s Int16 -> Int32 -> BoolReader s Int32
decodeRefineAc

data ComponentData s = ComponentData
  { forall s. ComponentData s -> Vector (Vector Int)
componentIndices    :: V.Vector (VS.Vector Int)
  , forall s. ComponentData s -> Vector (MutableMacroBlock s Int16)
componentBlocks     :: V.Vector (MutableMacroBlock s Int16)
  , forall s. ComponentData s -> Int
componentId         :: !Int
  , forall s. ComponentData s -> Int
componentBlockCount :: !Int
  }

-- | Iteration from 0 to n in monadic context, without data

-- keeping.

lineMap :: (Monad m) => Int -> (Int -> m ()) -> m ()
{-# INLINE lineMap #-}
lineMap :: forall (m :: * -> *). Monad m => Int -> (Int -> m ()) -> m ()
lineMap Int
count Int -> m ()
f = Int -> m ()
go Int
0
  where go :: Int -> m ()
go Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
count = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        go Int
n = Int -> m ()
f Int
n 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 ()
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

progressiveUnpack :: (Int, Int)
                  -> JpgFrameHeader
                  -> V.Vector (MacroBlock Int16)
                  -> [([(JpgUnpackerParameter, a)], L.ByteString)]
                  -> ST s (MutableImage s PixelYCbCr8)
progressiveUnpack :: forall a s.
(Int, Int)
-> JpgFrameHeader
-> Vector (MacroBlock Int16)
-> [([(JpgUnpackerParameter, a)], ByteString)]
-> ST s (MutableImage s PixelYCbCr8)
progressiveUnpack (Int
maxiW, Int
maxiH) JpgFrameHeader
frame Vector (MacroBlock Int16)
quants [([(JpgUnpackerParameter, a)], ByteString)]
lst = do
    (unpackers, readers) <- [([(JpgUnpackerParameter, a)], ByteString)]
-> ST
     s
     (Vector (Vector (JpgUnpackerParameter, Unpacker s)),
      STVector s BoolState)
forall a s.
[([(JpgUnpackerParameter, a)], ByteString)]
-> ST
     s
     (Vector (Vector (JpgUnpackerParameter, Unpacker s)),
      STVector s BoolState)
prepareUnpacker [([(JpgUnpackerParameter, a)], ByteString)]
lst
    allBlocks <- mapM allocateWorkingBlocks . zip [0..] $ jpgComponents frame
                    :: ST s [ComponentData s]
    let scanCount = [([(JpgUnpackerParameter, a)], ByteString)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [([(JpgUnpackerParameter, a)], ByteString)]
lst
        restartIntervalValue = case [([(JpgUnpackerParameter, a)], ByteString)]
lst of
                ((JpgUnpackerParameter
p,a
_):[(JpgUnpackerParameter, a)]
_,ByteString
_): [([(JpgUnpackerParameter, a)], ByteString)]
_ -> JpgUnpackerParameter -> Int
restartInterval JpgUnpackerParameter
p
                [([(JpgUnpackerParameter, a)], ByteString)]
_ -> -Int
1
    dcCoeffs <- MS.replicate imgComponentCount 0
    eobRuns <- MS.replicate (length lst) 0
    workBlock <- createEmptyMutableMacroBlock
    writeIndices <- MS.replicate imgComponentCount (0 :: Int)
    restartIntervals <- MS.replicate scanCount restartIntervalValue
    let elementCount = Int
imgWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
imgHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
imgComponentCount
    img <- MutableImage imgWidth imgHeight <$> MS.replicate elementCount 128

    let processRestartInterval =
          [Int] -> (Int -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0 .. Int
scanCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
ix -> do
            v <- MVector s Int
MVector (PrimState (ST s)) Int
restartIntervals MVector (PrimState (ST s)) Int -> Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`MS.read` Int
ix
            if v == 0 then do
              -- reset DC prediction

              when (ix == 0) (MS.set dcCoeffs 0)
              reader <- readers `M.read` ix
              (_, updated) <- runBoolReaderWith reader $
                  byteAlignJpg >> decodeRestartInterval
              (readers `M.write` ix) updated 
              (eobRuns `MS.unsafeWrite` ix) 0
              (restartIntervals `MS.unsafeWrite` ix) $ restartIntervalValue - 1
            else
              (restartIntervals `MS.unsafeWrite` ix) $ v - 1


    lineMap imageMcuHeight $ \Int
mmY -> do
      -- Reset all blocks to 0

      [ComponentData s] -> (ComponentData s -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ComponentData s]
allBlocks ((ComponentData s -> ST s ()) -> ST s ())
-> (ComponentData s -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ (MVector s Int16 -> ST s ()) -> Vector (MVector s Int16) -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ (MVector (PrimState (ST s)) Int16 -> Int16 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> a -> m ()
`MS.set` Int16
0) (Vector (MVector s Int16) -> ST s ())
-> (ComponentData s -> Vector (MVector s Int16))
-> ComponentData s
-> ST s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  ComponentData s -> Vector (MVector s Int16)
forall s. ComponentData s -> Vector (MutableMacroBlock s Int16)
componentBlocks
      MVector (PrimState (ST s)) Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> a -> m ()
MS.set MVector s Int
MVector (PrimState (ST s)) Int
writeIndices Int
0

      Int -> (Int -> ST s ()) -> ST s ()
forall (m :: * -> *). Monad m => Int -> (Int -> m ()) -> m ()
lineMap Int
imageMcuWidth ((Int -> ST s ()) -> ST s ()) -> (Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
_mmx -> do
        ST s ()
processRestartInterval 
        Vector (Vector (JpgUnpackerParameter, Unpacker s))
-> (Vector (JpgUnpackerParameter, Unpacker s) -> ST s ())
-> ST s ()
forall (m :: * -> *) a b. Monad m => Vector a -> (a -> m b) -> m ()
V.forM_ Vector (Vector (JpgUnpackerParameter, Unpacker s))
unpackers ((Vector (JpgUnpackerParameter, Unpacker s) -> ST s ()) -> ST s ())
-> (Vector (JpgUnpackerParameter, Unpacker s) -> ST s ())
-> ST s ()
forall a b. (a -> b) -> a -> b
$ ((JpgUnpackerParameter, Unpacker s) -> ST s ())
-> Vector (JpgUnpackerParameter, Unpacker s) -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ (((JpgUnpackerParameter, Unpacker s) -> ST s ())
 -> Vector (JpgUnpackerParameter, Unpacker s) -> ST s ())
-> ((JpgUnpackerParameter, Unpacker s) -> ST s ())
-> Vector (JpgUnpackerParameter, Unpacker s)
-> ST s ()
forall a b. (a -> b) -> a -> b
$ \(JpgUnpackerParameter
unpackParam, Unpacker s
unpacker) -> do
            boolState <- STVector s BoolState
MVector (PrimState (ST s)) BoolState
readers MVector (PrimState (ST s)) BoolState -> Int -> ST s BoolState
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
`M.read` JpgUnpackerParameter -> Int
readerIndex JpgUnpackerParameter
unpackParam
            eobrun <- eobRuns `MS.read` readerIndex unpackParam
            let componentNumber = JpgUnpackerParameter -> Int
componentIndex JpgUnpackerParameter
unpackParam
            writeIndex <- writeIndices `MS.read` componentNumber
            let componentData = [ComponentData s]
allBlocks [ComponentData s] -> Int -> ComponentData s
forall a. HasCallStack => [a] -> Int -> a
!! Int
componentNumber
                -- We get back the correct block indices for the number of component

                -- in the current scope (precalculated)

                indexVector =
                    ComponentData s -> Vector (Vector Int)
forall s. ComponentData s -> Vector (Vector Int)
componentIndices ComponentData s
componentData Vector (Vector Int) -> Int -> Vector Int
forall a. Vector a -> Int -> a
! JpgUnpackerParameter -> Int
indiceVector JpgUnpackerParameter
unpackParam
                maxIndexLength = Vector Int -> Int
forall a. Storable a => Vector a -> Int
VS.length Vector Int
indexVector
            unless (writeIndex + blockIndex unpackParam >= maxIndexLength) $ do
               let realIndex = Vector Int
indexVector Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
VS.! (Int
writeIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ JpgUnpackerParameter -> Int
blockIndex JpgUnpackerParameter
unpackParam)
                   writeBlock = ComponentData s -> Vector (MVector s Int16)
forall s. ComponentData s -> Vector (MutableMacroBlock s Int16)
componentBlocks ComponentData s
componentData Vector (MVector s Int16) -> Int -> MVector s Int16
forall a. Vector a -> Int -> a
! Int
realIndex
               (eobrun', state) <-
                   runBoolReaderWith boolState $
                       unpacker unpackParam dcCoeffs writeBlock eobrun

               (readers `M.write` readerIndex unpackParam) state
               (eobRuns `MS.write` readerIndex unpackParam) eobrun'

        -- Update the write indices

        [ComponentData s] -> (ComponentData s -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ComponentData s]
allBlocks ((ComponentData s -> ST s ()) -> ST s ())
-> (ComponentData s -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \ComponentData s
comp -> do
          writeIndex <- MVector s Int
MVector (PrimState (ST s)) Int
writeIndices MVector (PrimState (ST s)) Int -> Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
`MS.read` ComponentData s -> Int
forall s. ComponentData s -> Int
componentId ComponentData s
comp
          let newIndex = Int
writeIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ComponentData s -> Int
forall s. ComponentData s -> Int
componentBlockCount ComponentData s
comp
          (writeIndices `MS.write` componentId comp) newIndex

      [ComponentData s] -> (ComponentData s -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ComponentData s]
allBlocks ((ComponentData s -> ST s ()) -> ST s ())
-> (ComponentData s -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \ComponentData s
compData -> do
        let compBlocks :: Vector (MVector s Int16)
compBlocks = ComponentData s -> Vector (MVector s Int16)
forall s. ComponentData s -> Vector (MutableMacroBlock s Int16)
componentBlocks ComponentData s
compData
            cId :: Int
cId = ComponentData s -> Int
forall s. ComponentData s -> Int
componentId ComponentData s
compData
            comp :: JpgComponent
comp = JpgFrameHeader -> [JpgComponent]
jpgComponents JpgFrameHeader
frame [JpgComponent] -> Int -> JpgComponent
forall a. HasCallStack => [a] -> Int -> a
!! Int
cId
            quantId :: Int
quantId =
                Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ JpgComponent -> Word8
quantizationTableDest JpgComponent
comp
            table :: MacroBlock Int16
table = Vector (MacroBlock Int16)
quants Vector (MacroBlock Int16) -> Int -> MacroBlock Int16
forall a. Vector a -> Int -> a
! Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
3 Int
quantId
            compW :: Int
compW = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ JpgComponent -> Word8
horizontalSamplingFactor JpgComponent
comp
            compH :: Int
compH = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ JpgComponent -> Word8
verticalSamplingFactor JpgComponent
comp
            cw8 :: Int
cw8 = Int
maxiW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (JpgComponent -> Word8
horizontalSamplingFactor JpgComponent
comp) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            ch8 :: Int
ch8 = Int
maxiH Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (JpgComponent -> Word8
verticalSamplingFactor JpgComponent
comp) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

        Int -> Int -> (Int -> Int -> ST s ()) -> ST s ()
forall (m :: * -> *).
Monad m =>
Int -> Int -> (Int -> Int -> m ()) -> m ()
rasterMap (Int
imageMcuWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
compW) Int
compH ((Int -> Int -> ST s ()) -> ST s ())
-> (Int -> Int -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Int
rx Int
y -> do
            let ry :: Int
ry = Int
mmY Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
maxiH Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y
                block :: MVector s Int16
block = Vector (MVector s Int16)
compBlocks Vector (MVector s Int16) -> Int -> MVector s Int16
forall a. Vector a -> Int -> a
! (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
imageMcuWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
compW Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rx)
            transformed <- MacroBlock Int16
-> MVector s Int16 -> MVector s Int16 -> ST s (MVector s Int16)
forall s.
MacroBlock Int16
-> MutableMacroBlock s Int16
-> MutableMacroBlock s Int16
-> ST s (MutableMacroBlock s Int16)
decodeMacroBlock MacroBlock Int16
table MVector s Int16
workBlock MVector s Int16
block
            unpackMacroBlock imgComponentCount
                    cw8 ch8 cId (rx * cw8) ry
                    img transformed

    return img

  where imgComponentCount :: Int
imgComponentCount = [JpgComponent] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([JpgComponent] -> Int) -> [JpgComponent] -> Int
forall a b. (a -> b) -> a -> b
$ JpgFrameHeader -> [JpgComponent]
jpgComponents JpgFrameHeader
frame

        imgWidth :: Int
imgWidth = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ JpgFrameHeader -> Word16
jpgWidth JpgFrameHeader
frame
        imgHeight :: Int
imgHeight = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ JpgFrameHeader -> Word16
jpgHeight JpgFrameHeader
frame

        imageBlockWidth :: Int
imageBlockWidth = Int -> Int
toBlockSize Int
imgWidth
        imageBlockHeight :: Int
imageBlockHeight = Int -> Int
toBlockSize Int
imgHeight

        imageMcuWidth :: Int
imageMcuWidth =  (Int
imageBlockWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
maxiW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
maxiW
        imageMcuHeight :: Int
imageMcuHeight = (Int
imageBlockHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
maxiH Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
maxiH

        allocateWorkingBlocks :: (Int, JpgComponent) -> ST s (ComponentData s)
allocateWorkingBlocks (Int
ix, JpgComponent
comp) = do
            let blockCount :: Int
blockCount = Int
hSample Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
vSample Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
imageMcuWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
            blocks <- Int
-> ST s (MutableMacroBlock s Int16)
-> ST s (Vector (MutableMacroBlock s Int16))
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
blockCount ST s (MutableMacroBlock s Int16)
forall a s. (Storable a, Num a) => ST s (MutableMacroBlock s a)
createEmptyMutableMacroBlock
            return ComponentData 
                { componentBlocks = blocks
                , componentIndices = createMcuLineIndices comp imgWidth imageMcuWidth
                , componentBlockCount = hSample * vSample
                , componentId = ix
                }
            where hSample :: Int
hSample = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ JpgComponent -> Word8
horizontalSamplingFactor JpgComponent
comp
                  vSample :: Int
vSample = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ JpgComponent -> Word8
verticalSamplingFactor JpgComponent
comp