{-# 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
.!!!. :: forall a s. Storable a => STVector s a -> Int -> ST s a
(.!!!.) = MVector s a -> Int -> ST s a
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
{-# INLINE (..!!!..) #-}
(..!!!..) :: (MonadTrans t, Storable a)
=> M.STVector s a -> Int -> t (ST s) a
..!!!.. :: forall (t :: (* -> *) -> * -> *) a s.
(MonadTrans t, Storable a) =>
STVector s a -> Int -> t (ST s) a
(..!!!..) STVector s a
v Int
idx = ST s a -> t (ST s) a
forall (m :: * -> *) a. Monad m => m a -> t m 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 ()
.<-. :: forall a s. Storable a => STVector s a -> Int -> a -> ST s ()
(.<-.) = MVector s a -> Int -> a -> ST s ()
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
{-# INLINE (..<-..) #-}
(..<-..) :: (MonadTrans t, Storable a)
=> M.STVector s a -> Int -> a -> t (ST s) ()
..<-.. :: forall (t :: (* -> *) -> * -> *) a s.
(MonadTrans t, Storable a) =>
STVector s a -> Int -> a -> t (ST s) ()
(..<-..) STVector s a
v Int
idx = ST s () -> t (ST s) ()
forall (m :: * -> *) a. Monad m => m a -> t m a
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 :: forall (t :: (* -> *) -> * -> *) a s.
(MonadTrans t, Storable a) =>
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 (m :: * -> *) a. Monad m => m a -> t m a
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 a. a -> ST s a
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 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
>>= (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 :: forall a s.
(Storable a, Num a) =>
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 a. a -> ST 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 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 (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 :: forall s.
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 HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
`B.index` Int
0
secondByte :: Word8
secondByte = (ByteString
str HasCallStack => ByteString -> Int -> Word8
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 :: forall s. 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
$c== :: TiffVariant -> TiffVariant -> Bool
== :: TiffVariant -> TiffVariant -> Bool
$c/= :: TiffVariant -> TiffVariant -> Bool
/= :: TiffVariant -> TiffVariant -> Bool
Eq
lzw :: TiffVariant -> Int -> Int -> Int -> M.STVector s Word8
-> BoolReader s ()
lzw :: forall s.
TiffVariant
-> Int -> Int -> Int -> STVector s Word8 -> BoolReader s ()
lzw TiffVariant
variant Int
nMaxBitKeySize Int
initialKeySize Int
initialWriteIdx STVector s Word8
outVec = do
STVector s Word8
lzwData <- ST s (STVector s Word8)
-> StateT BoolState (ST s) (STVector s Word8)
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 (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 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
>>= 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 (m :: * -> *) a. Monad m => m a -> StateT BoolState m a
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 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
>>= 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 (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 (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 (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 () -> 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 a. a -> t (ST s) a
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 a. a -> t (ST s) a
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 a. a -> StateT BoolState (ST s) a
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 a. a -> StateT BoolState (ST s) a
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 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
>>=
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 a. a -> StateT BoolState (ST s) a
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 a. a -> StateT BoolState (ST s) a
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 {a}. Integral a => a -> Int -> a
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 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
>>=
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 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
>>=
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 (m :: * -> *) a. Monad m => m a -> t m 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 :: a -> Int -> a
updateCodeSize a
codeSize Int
writeIdx
| Int
writeIdx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Int -> a -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ a
codeSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
switchOffset = a -> a -> a
forall a. Ord a => a -> a -> a
min a
12 (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
codeSize a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
| Bool
otherwise = a
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