{-# LANGUAGE CPP #-}
module Codec.Picture.Gif.Internal.LZW( decodeLzw, decodeLzwTiff ) where

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

import Data.Word( Word8 )
import Control.Monad( when, unless )

import Data.Bits( (.&.) )

import Control.Monad.ST( ST )
import Control.Monad.Trans.Class( MonadTrans, lift )

import Foreign.Storable ( Storable )

import qualified Data.ByteString as B
import qualified Data.Vector.Storable.Mutable as M

import Codec.Picture.BitWriter

{-# INLINE (.!!!.) #-}
(.!!!.) :: (Storable a) => M.STVector s a -> Int -> ST s a
.!!!. :: STVector s a -> Int -> ST s a
(.!!!.) = STVector s a -> Int -> ST s a
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> m a
M.unsafeRead 
        {-M.read-}

{-# INLINE (..!!!..) #-}
(..!!!..) :: (MonadTrans t, Storable a)
          => M.STVector s a -> Int -> t (ST s) a
..!!!.. :: STVector s a -> Int -> t (ST s) a
(..!!!..) STVector s a
v Int
idx = ST s a -> t (ST s) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s a -> t (ST s) a) -> ST s a -> t (ST s) a
forall a b. (a -> b) -> a -> b
$ STVector s a
v STVector s a -> Int -> ST s a
forall a s. Storable a => STVector s a -> Int -> ST s a
.!!!. Int
idx

{-# INLINE (.<-.) #-}
(.<-.) :: (Storable a) => M.STVector s a -> Int -> a -> ST s ()
.<-. :: STVector s a -> Int -> a -> ST s ()
(.<-.) = STVector s a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
M.unsafeWrite 
         {-M.write-}

{-# INLINE (..<-..) #-}
(..<-..) :: (MonadTrans t, Storable a)
         => M.STVector s a -> Int -> a -> t (ST s) ()
..<-.. :: STVector s a -> Int -> a -> t (ST s) ()
(..<-..) STVector s a
v Int
idx = ST s () -> t (ST s) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s () -> t (ST s) ()) -> (a -> ST s ()) -> a -> t (ST s) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (STVector s a
v STVector s a -> Int -> a -> ST s ()
forall a s. Storable a => STVector s a -> Int -> a -> ST s ()
.<-. Int
idx)


duplicateData :: (MonadTrans t, Storable a)
              => M.STVector s a -> M.STVector s a
              -> Int -> Int -> Int -> t (ST s) ()
duplicateData :: STVector s a -> STVector s a -> Int -> Int -> Int -> t (ST s) ()
duplicateData STVector s a
src STVector s a
dest Int
sourceIndex Int
size Int
destIndex = ST s () -> t (ST s) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s () -> t (ST s) ()) -> ST s () -> t (ST s) ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ST s ()
aux Int
sourceIndex Int
destIndex
  where endIndex :: Int
endIndex = Int
sourceIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size
        aux :: Int -> Int -> ST s ()
aux Int
i Int
_ | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
endIndex  = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        aux Int
i Int
j = do
          STVector s a
src STVector s a -> Int -> ST s a
forall a s. Storable a => STVector s a -> Int -> ST s a
.!!!. Int
i ST s a -> (a -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (STVector s a
dest STVector s a -> Int -> a -> ST s ()
forall a s. Storable a => STVector s a -> Int -> a -> ST s ()
.<-. Int
j)
          Int -> Int -> ST s ()
aux (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

rangeSetter :: (Storable a, Num a)
            => Int -> M.STVector s a
            -> ST s (M.STVector s a)
rangeSetter :: Int -> STVector s a -> ST s (STVector s a)
rangeSetter Int
count STVector s a
vec = Int -> ST s (STVector s a)
aux Int
0
  where aux :: Int -> ST s (STVector s a)
aux Int
n | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
count = STVector s a -> ST s (STVector s a)
forall (m :: * -> *) a. Monad m => a -> m a
return STVector s a
vec
        aux Int
n = (STVector s a
vec STVector s a -> Int -> a -> ST s ()
forall a s. Storable a => STVector s a -> Int -> a -> ST s ()
.<-. Int
n) (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) ST s () -> ST s (STVector s a) -> ST s (STVector s a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s (STVector s a)
aux (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

decodeLzw :: B.ByteString -> Int -> Int -> M.STVector s Word8
          -> BoolReader s ()
decodeLzw :: ByteString -> Int -> Int -> STVector s Word8 -> BoolReader s ()
decodeLzw ByteString
str Int
maxBitKey Int
initialKey STVector s Word8
outVec = do
    ByteString -> BoolReader s ()
forall s. ByteString -> BoolReader s ()
setDecodedString ByteString
str
    TiffVariant
-> Int -> Int -> Int -> STVector s Word8 -> BoolReader s ()
forall s.
TiffVariant
-> Int -> Int -> Int -> STVector s Word8 -> BoolReader s ()
lzw TiffVariant
GifVariant Int
maxBitKey Int
initialKey Int
0 STVector s Word8
outVec

isOldTiffLZW :: B.ByteString -> Bool
isOldTiffLZW :: ByteString -> Bool
isOldTiffLZW ByteString
str = Word8
firstByte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 Bool -> Bool -> Bool
&& Word8
secondByte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1
    where firstByte :: Word8
firstByte = ByteString
str ByteString -> Int -> Word8
`B.index` Int
0
          secondByte :: Word8
secondByte = (ByteString
str ByteString -> Int -> Word8
`B.index` Int
1) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
1

decodeLzwTiff :: B.ByteString -> M.STVector s Word8 -> Int
              -> BoolReader s()
decodeLzwTiff :: ByteString -> STVector s Word8 -> Int -> BoolReader s ()
decodeLzwTiff ByteString
str STVector s Word8
outVec Int
initialWriteIdx = do
    if ByteString -> Bool
isOldTiffLZW ByteString
str then
      ByteString -> BoolReader s ()
forall s. ByteString -> BoolReader s ()
setDecodedString ByteString
str
    else
      ByteString -> BoolReader s ()
forall s. ByteString -> BoolReader s ()
setDecodedStringMSB ByteString
str
    let variant :: TiffVariant
variant | ByteString -> Bool
isOldTiffLZW ByteString
str = TiffVariant
OldTiffVariant
                | Bool
otherwise = TiffVariant
TiffVariant
    TiffVariant
-> Int -> Int -> Int -> STVector s Word8 -> BoolReader s ()
forall s.
TiffVariant
-> Int -> Int -> Int -> STVector s Word8 -> BoolReader s ()
lzw TiffVariant
variant Int
12 Int
9 Int
initialWriteIdx STVector s Word8
outVec

data TiffVariant =
      GifVariant
    | TiffVariant
    | OldTiffVariant
    deriving TiffVariant -> TiffVariant -> Bool
(TiffVariant -> TiffVariant -> Bool)
-> (TiffVariant -> TiffVariant -> Bool) -> Eq TiffVariant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TiffVariant -> TiffVariant -> Bool
$c/= :: TiffVariant -> TiffVariant -> Bool
== :: TiffVariant -> TiffVariant -> Bool
$c== :: TiffVariant -> TiffVariant -> Bool
Eq

-- | Gif image constraint from spec-gif89a, code size max : 12 bits.

lzw :: TiffVariant -> Int -> Int -> Int -> M.STVector s Word8
    -> BoolReader s ()
lzw :: TiffVariant
-> Int -> Int -> Int -> STVector s Word8 -> BoolReader s ()
lzw TiffVariant
variant Int
nMaxBitKeySize Int
initialKeySize Int
initialWriteIdx STVector s Word8
outVec = do
    -- Allocate buffer of maximum size.

    STVector s Word8
lzwData <- ST s (STVector s Word8)
-> StateT BoolState (ST s) (STVector s Word8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Word8 -> ST s (MVector (PrimState (ST s)) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> a -> m (MVector (PrimState m) a)
M.replicate Int
maxDataSize Word8
0) StateT BoolState (ST s) (STVector s Word8)
-> (STVector s Word8 -> StateT BoolState (ST s) (STVector s Word8))
-> StateT BoolState (ST s) (STVector s Word8)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STVector s Word8 -> StateT BoolState (ST s) (STVector s Word8)
forall (t :: (* -> *) -> * -> *) a s.
(MonadTrans t, Storable a, Num a) =>
STVector s a -> t (ST s) (STVector s a)
resetArray
    STVector s Int
lzwOffsetTable <- ST s (STVector s Int) -> StateT BoolState (ST s) (STVector s Int)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> Int -> ST s (MVector (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> a -> m (MVector (PrimState m) a)
M.replicate Int
tableEntryCount Int
0) StateT BoolState (ST s) (STVector s Int)
-> (STVector s Int -> StateT BoolState (ST s) (STVector s Int))
-> StateT BoolState (ST s) (STVector s Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STVector s Int -> StateT BoolState (ST s) (STVector s Int)
forall (t :: (* -> *) -> * -> *) a s.
(MonadTrans t, Storable a, Num a) =>
STVector s a -> t (ST s) (STVector s a)
resetArray
    STVector s Int
lzwSizeTable <- ST s (STVector s Int) -> StateT BoolState (ST s) (STVector s Int)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s (STVector s Int) -> StateT BoolState (ST s) (STVector s Int))
-> ST s (STVector s Int)
-> StateT BoolState (ST s) (STVector s Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ST s (MVector (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> a -> m (MVector (PrimState m) a)
M.replicate Int
tableEntryCount Int
0
    ST s () -> BoolReader s ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s () -> BoolReader s ()) -> ST s () -> BoolReader s ()
forall a b. (a -> b) -> a -> b
$ STVector s Int
MVector (PrimState (ST s)) Int
lzwSizeTable MVector (PrimState (ST s)) Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> a -> m ()
`M.set` Int
1

    let firstVal :: Int -> t (ST s) Word8
firstVal Int
code = do
            Int
dataOffset <- STVector s Int
lzwOffsetTable STVector s Int -> Int -> t (ST s) Int
forall (t :: (* -> *) -> * -> *) a s.
(MonadTrans t, Storable a) =>
STVector s a -> Int -> t (ST s) a
..!!!.. Int
code
            STVector s Word8
lzwData STVector s Word8 -> Int -> t (ST s) Word8
forall (t :: (* -> *) -> * -> *) a s.
(MonadTrans t, Storable a) =>
STVector s a -> Int -> t (ST s) a
..!!!.. Int
dataOffset

        writeString :: Int -> Int -> t (ST s) Int
writeString Int
at Int
code = do
            Int
dataOffset <- STVector s Int
lzwOffsetTable STVector s Int -> Int -> t (ST s) Int
forall (t :: (* -> *) -> * -> *) a s.
(MonadTrans t, Storable a) =>
STVector s a -> Int -> t (ST s) a
..!!!.. Int
code
            Int
dataSize   <- STVector s Int
lzwSizeTable   STVector s Int -> Int -> t (ST s) Int
forall (t :: (* -> *) -> * -> *) a s.
(MonadTrans t, Storable a) =>
STVector s a -> Int -> t (ST s) a
..!!!.. Int
code

            Bool -> t (ST s) () -> t (ST s) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dataSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxWrite) (t (ST s) () -> t (ST s) ()) -> t (ST s) () -> t (ST s) ()
forall a b. (a -> b) -> a -> b
$
                 STVector s Word8
-> STVector s Word8 -> Int -> Int -> Int -> t (ST s) ()
forall (t :: (* -> *) -> * -> *) a s.
(MonadTrans t, Storable a) =>
STVector s a -> STVector s a -> Int -> Int -> Int -> t (ST s) ()
duplicateData STVector s Word8
lzwData STVector s Word8
outVec Int
dataOffset Int
dataSize Int
at

            Int -> t (ST s) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
dataSize

        addString :: Int -> Int -> Int -> Word8 -> t (ST s) Int
addString Int
pos Int
at Int
code Word8
val = do
            Int
dataOffset <- STVector s Int
lzwOffsetTable STVector s Int -> Int -> t (ST s) Int
forall (t :: (* -> *) -> * -> *) a s.
(MonadTrans t, Storable a) =>
STVector s a -> Int -> t (ST s) a
..!!!.. Int
code
            Int
dataSize   <- STVector s Int
lzwSizeTable   STVector s Int -> Int -> t (ST s) Int
forall (t :: (* -> *) -> * -> *) a s.
(MonadTrans t, Storable a) =>
STVector s a -> Int -> t (ST s) a
..!!!.. Int
code

            Bool -> t (ST s) () -> t (ST s) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
tableEntryCount) (t (ST s) () -> t (ST s) ()) -> t (ST s) () -> t (ST s) ()
forall a b. (a -> b) -> a -> b
$ do
              (STVector s Int
lzwOffsetTable STVector s Int -> Int -> Int -> t (ST s) ()
forall (t :: (* -> *) -> * -> *) a s.
(MonadTrans t, Storable a) =>
STVector s a -> Int -> a -> t (ST s) ()
..<-.. Int
pos) Int
at
              (STVector s Int
lzwSizeTable STVector s Int -> Int -> Int -> t (ST s) ()
forall (t :: (* -> *) -> * -> *) a s.
(MonadTrans t, Storable a) =>
STVector s a -> Int -> a -> t (ST s) ()
..<-.. Int
pos) (Int -> t (ST s) ()) -> Int -> t (ST s) ()
forall a b. (a -> b) -> a -> b
$ Int
dataSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

            Bool -> t (ST s) () -> t (ST s) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dataSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxDataSize) (t (ST s) () -> t (ST s) ()) -> t (ST s) () -> t (ST s) ()
forall a b. (a -> b) -> a -> b
$ do
              STVector s Word8
-> STVector s Word8 -> Int -> Int -> Int -> t (ST s) ()
forall (t :: (* -> *) -> * -> *) a s.
(MonadTrans t, Storable a) =>
STVector s a -> STVector s a -> Int -> Int -> Int -> t (ST s) ()
duplicateData STVector s Word8
lzwData STVector s Word8
lzwData Int
dataOffset Int
dataSize Int
at
              (STVector s Word8
lzwData STVector s Word8 -> Int -> Word8 -> t (ST s) ()
forall (t :: (* -> *) -> * -> *) a s.
(MonadTrans t, Storable a) =>
STVector s a -> Int -> a -> t (ST s) ()
..<-.. (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dataSize)) Word8
val

            Int -> t (ST s) Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> t (ST s) Int) -> Int -> t (ST s) Int
forall a b. (a -> b) -> a -> b
$ Int
dataSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

        maxWrite :: Int
maxWrite = STVector s Word8 -> Int
forall a s. Storable a => MVector s a -> Int
M.length STVector s Word8
outVec
        loop :: Int -> Int -> Int -> Int -> Int -> Int -> BoolReader s ()
loop Int
outWriteIdx Int
writeIdx Int
dicWriteIdx Int
codeSize Int
oldCode Int
code
          | Int
outWriteIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxWrite = () -> BoolReader s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          | Int
code Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
endOfInfo = () -> BoolReader s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          | Int
code Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
clearCode = do
              Int
toOutput <- Int -> StateT BoolState (ST s) Int
forall b s. Num b => Int -> StateT BoolState (ST s) b
getNextCode Int
startCodeSize
              Bool -> BoolReader s () -> BoolReader s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
toOutput Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
endOfInfo) (BoolReader s () -> BoolReader s ())
-> BoolReader s () -> BoolReader s ()
forall a b. (a -> b) -> a -> b
$ do
                Int
dataSize <- Int -> Int -> StateT BoolState (ST s) Int
forall (t :: (* -> *) -> * -> *).
(Monad (t (ST s)), MonadTrans t) =>
Int -> Int -> t (ST s) Int
writeString Int
outWriteIdx Int
toOutput
                Int -> StateT BoolState (ST s) Int
forall b s. Num b => Int -> StateT BoolState (ST s) b
getNextCode Int
startCodeSize StateT BoolState (ST s) Int
-> (Int -> BoolReader s ()) -> BoolReader s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                  Int -> Int -> Int -> Int -> Int -> Int -> BoolReader s ()
loop (Int
outWriteIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dataSize)
                       Int
firstFreeIndex Int
firstFreeIndex Int
startCodeSize Int
toOutput

          | Bool
otherwise =  do
              (Int
written, Int
dicAdd) <-
                   if Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
writeIdx then do
                     Word8
c <- Int -> StateT BoolState (ST s) Word8
forall (t :: (* -> *) -> * -> *).
(Monad (t (ST s)), MonadTrans t) =>
Int -> t (ST s) Word8
firstVal Int
oldCode
                     Int
wroteSize <- Int -> Int -> StateT BoolState (ST s) Int
forall (t :: (* -> *) -> * -> *).
(Monad (t (ST s)), MonadTrans t) =>
Int -> Int -> t (ST s) Int
writeString Int
outWriteIdx Int
oldCode
                     (STVector s Word8
outVec STVector s Word8 -> Int -> Word8 -> BoolReader s ()
forall (t :: (* -> *) -> * -> *) a s.
(MonadTrans t, Storable a) =>
STVector s a -> Int -> a -> t (ST s) ()
..<-.. (Int
outWriteIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wroteSize)) Word8
c
                     Int
addedSize <- Int -> Int -> Int -> Word8 -> StateT BoolState (ST s) Int
forall (t :: (* -> *) -> * -> *).
(Monad (t (ST s)), MonadTrans t) =>
Int -> Int -> Int -> Word8 -> t (ST s) Int
addString Int
writeIdx Int
dicWriteIdx Int
oldCode Word8
c
                     (Int, Int) -> StateT BoolState (ST s) (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
wroteSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
addedSize)
                   else do
                     Int
wroteSize <- Int -> Int -> StateT BoolState (ST s) Int
forall (t :: (* -> *) -> * -> *).
(Monad (t (ST s)), MonadTrans t) =>
Int -> Int -> t (ST s) Int
writeString Int
outWriteIdx Int
code
                     Word8
c <- Int -> StateT BoolState (ST s) Word8
forall (t :: (* -> *) -> * -> *).
(Monad (t (ST s)), MonadTrans t) =>
Int -> t (ST s) Word8
firstVal Int
code
                     Int
addedSize <- Int -> Int -> Int -> Word8 -> StateT BoolState (ST s) Int
forall (t :: (* -> *) -> * -> *).
(Monad (t (ST s)), MonadTrans t) =>
Int -> Int -> Int -> Word8 -> t (ST s) Int
addString Int
writeIdx Int
dicWriteIdx Int
oldCode Word8
c
                     (Int, Int) -> StateT BoolState (ST s) (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
wroteSize, Int
addedSize)

              let new_code_size :: Int
new_code_size = Int -> Int -> Int
forall p. Integral p => p -> Int -> p
updateCodeSize Int
codeSize (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
              Int -> StateT BoolState (ST s) Int
forall b s. Num b => Int -> StateT BoolState (ST s) b
getNextCode Int
new_code_size StateT BoolState (ST s) Int
-> (Int -> BoolReader s ()) -> BoolReader s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                Int -> Int -> Int -> Int -> Int -> Int -> BoolReader s ()
loop (Int
outWriteIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
written)
                     (Int
writeIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                     (Int
dicWriteIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dicAdd)
                     Int
new_code_size
                     Int
code

    Int -> StateT BoolState (ST s) Int
forall b s. Num b => Int -> StateT BoolState (ST s) b
getNextCode Int
startCodeSize StateT BoolState (ST s) Int
-> (Int -> BoolReader s ()) -> BoolReader s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        Int -> Int -> Int -> Int -> Int -> Int -> BoolReader s ()
loop Int
initialWriteIdx Int
firstFreeIndex Int
firstFreeIndex Int
startCodeSize Int
0

  where tableEntryCount :: Int
tableEntryCount =  Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
12 Int
nMaxBitKeySize
        maxDataSize :: Int
maxDataSize = Int
tableEntryCount Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tableEntryCount) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

        isNewTiff :: Bool
isNewTiff = TiffVariant
variant TiffVariant -> TiffVariant -> Bool
forall a. Eq a => a -> a -> Bool
== TiffVariant
TiffVariant
        (Int
switchOffset,  Bool
isTiffVariant) = case TiffVariant
variant of
            TiffVariant
GifVariant -> (Int
0, Bool
False)
            TiffVariant
TiffVariant -> (Int
1, Bool
True)
            TiffVariant
OldTiffVariant -> (Int
0, Bool
True)

        initialElementCount :: Int
initialElementCount = Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
initialKeySize :: Int
        clearCode :: Int
clearCode | Bool
isTiffVariant = Int
256
                  | Bool
otherwise = Int
initialElementCount

        endOfInfo :: Int
endOfInfo | Bool
isTiffVariant = Int
257
                  | Bool
otherwise = Int
clearCode Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

        startCodeSize :: Int
startCodeSize 
                  | Bool
isTiffVariant = Int
initialKeySize
                  | Bool
otherwise = Int
initialKeySize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

        firstFreeIndex :: Int
firstFreeIndex = Int
endOfInfo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

        resetArray :: STVector s a -> t (ST s) (STVector s a)
resetArray STVector s a
a = ST s (STVector s a) -> t (ST s) (STVector s a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s (STVector s a) -> t (ST s) (STVector s a))
-> ST s (STVector s a) -> t (ST s) (STVector s a)
forall a b. (a -> b) -> a -> b
$ Int -> STVector s a -> ST s (STVector s a)
forall a s.
(Storable a, Num a) =>
Int -> STVector s a -> ST s (STVector s a)
rangeSetter Int
initialElementCount STVector s a
a

        updateCodeSize :: p -> Int -> p
updateCodeSize p
codeSize Int
writeIdx
            | Int
writeIdx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Int -> p -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ p
codeSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
switchOffset = p -> p -> p
forall a. Ord a => a -> a -> a
min p
12 (p -> p) -> p -> p
forall a b. (a -> b) -> a -> b
$ p
codeSize p -> p -> p
forall a. Num a => a -> a -> a
+ p
1
            | Bool
otherwise = p
codeSize

        getNextCode :: Int -> StateT BoolState (ST s) b
getNextCode Int
s 
            | Bool
isNewTiff = Word32 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> b)
-> StateT BoolState (ST s) Word32 -> StateT BoolState (ST s) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT BoolState (ST s) Word32
forall s. Int -> BoolReader s Word32
getNextBitsMSBFirst Int
s
            | Bool
otherwise = Word32 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> b)
-> StateT BoolState (ST s) Word32 -> StateT BoolState (ST s) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT BoolState (ST s) Word32
forall s. Int -> BoolReader s Word32
getNextBitsLSBFirst Int
s