{-# LANGUAGE CPP #-}
-- | Low level png module, you should import 'Codec.Picture.Png.Internal' instead.

module Codec.Picture.Png.Internal.Type( PngIHdr( .. )
                             , PngFilter( .. )
                             , PngInterlaceMethod( .. )
                             , PngPalette
                             , PngImageType( .. )
                             , PngPhysicalDimension( .. )
                             , PngGamma( .. )
                             , PngUnit( .. )
                             , APngAnimationControl( .. )
                             , APngFrameDisposal( .. )
                             , APngBlendOp( .. )
                             , APngFrameControl( .. )
                             , parsePalette 
                             , pngComputeCrc
                             , pLTESignature
                             , iDATSignature
                             , iENDSignature
                             , tRNSSignature
                             , tEXtSignature
                             , zTXtSignature
                             , gammaSignature
                             , pHYsSignature
                             , animationControlSignature
                             -- * Low level types

                             , ChunkSignature
                             , PngRawImage( .. )
                             , PngChunk( .. )
                             , PngRawChunk( .. )
                             , PngLowLevel( .. )
                             , chunksWithSig
                             , mkRawChunk
                             ) where

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

import Control.Monad( when, replicateM )
import Data.Bits( xor, (.&.), unsafeShiftR )
import Data.Binary( Binary(..), Get, get )
import Data.Binary.Get( getWord8
                      , getWord32be
                      , getLazyByteString
                      )
import Data.Binary.Put( runPut
                      , putWord8
                      , putWord32be
                      , putLazyByteString
                      )
import Data.Vector.Unboxed( Vector, fromListN, (!) )
import qualified Data.Vector.Storable as V
import Data.List( foldl' )
import Data.Word( Word32, Word16, Word8 )
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as LS

import Codec.Picture.Types
import Codec.Picture.InternalHelper

--------------------------------------------------

----            Types

--------------------------------------------------


-- | Value used to identify a png chunk, must be 4 bytes long.

type ChunkSignature = L.ByteString

-- | Generic header used in PNG images.

data PngIHdr = PngIHdr
    { PngIHdr -> Word32
width             :: !Word32       -- ^ Image width in number of pixel

    , PngIHdr -> Word32
height            :: !Word32       -- ^ Image height in number of pixel

    , PngIHdr -> Word8
bitDepth          :: !Word8        -- ^ Number of bit per sample

    , PngIHdr -> PngImageType
colourType        :: !PngImageType -- ^ Kind of png image (greyscale, true color, indexed...)

    , PngIHdr -> Word8
compressionMethod :: !Word8        -- ^ Compression method used

    , PngIHdr -> Word8
filterMethod      :: !Word8        -- ^ Must be 0

    , PngIHdr -> PngInterlaceMethod
interlaceMethod   :: !PngInterlaceMethod   -- ^ If the image is interlaced (for progressive rendering)

    }
    deriving Int -> PngIHdr -> ShowS
[PngIHdr] -> ShowS
PngIHdr -> String
(Int -> PngIHdr -> ShowS)
-> (PngIHdr -> String) -> ([PngIHdr] -> ShowS) -> Show PngIHdr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PngIHdr] -> ShowS
$cshowList :: [PngIHdr] -> ShowS
show :: PngIHdr -> String
$cshow :: PngIHdr -> String
showsPrec :: Int -> PngIHdr -> ShowS
$cshowsPrec :: Int -> PngIHdr -> ShowS
Show

data PngUnit
    = PngUnitUnknown -- ^ 0 value

    | PngUnitMeter   -- ^ 1 value


instance Binary PngUnit where
  get :: Get PngUnit
get = do
    Word8
v <- Get Word8
getWord8
    PngUnit -> Get PngUnit
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PngUnit -> Get PngUnit) -> PngUnit -> Get PngUnit
forall a b. (a -> b) -> a -> b
$ case Word8
v of
      Word8
0 -> PngUnit
PngUnitUnknown
      Word8
1 -> PngUnit
PngUnitMeter
      Word8
_ -> PngUnit
PngUnitUnknown
  
  put :: PngUnit -> Put
put PngUnit
v = case PngUnit
v of
    PngUnit
PngUnitUnknown -> Word8 -> Put
putWord8 Word8
0
    PngUnit
PngUnitMeter -> Word8 -> Put
putWord8 Word8
1

data PngPhysicalDimension = PngPhysicalDimension
    { PngPhysicalDimension -> Word32
pngDpiX     :: !Word32
    , PngPhysicalDimension -> Word32
pngDpiY     :: !Word32
    , PngPhysicalDimension -> PngUnit
pngUnit     :: !PngUnit
    }

instance Binary PngPhysicalDimension where
  get :: Get PngPhysicalDimension
get = Word32 -> Word32 -> PngUnit -> PngPhysicalDimension
PngPhysicalDimension (Word32 -> Word32 -> PngUnit -> PngPhysicalDimension)
-> Get Word32 -> Get (Word32 -> PngUnit -> PngPhysicalDimension)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be Get (Word32 -> PngUnit -> PngPhysicalDimension)
-> Get Word32 -> Get (PngUnit -> PngPhysicalDimension)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
getWord32be Get (PngUnit -> PngPhysicalDimension)
-> Get PngUnit -> Get PngPhysicalDimension
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get PngUnit
forall t. Binary t => Get t
get
  put :: PngPhysicalDimension -> Put
put (PngPhysicalDimension Word32
dpx Word32
dpy PngUnit
unit) =
    Word32 -> Put
putWord32be Word32
dpx Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
putWord32be Word32
dpy Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PngUnit -> Put
forall t. Binary t => t -> Put
put PngUnit
unit

newtype PngGamma = PngGamma { PngGamma -> Double
getPngGamma :: Double }

instance Binary PngGamma where
  get :: Get PngGamma
get = Double -> PngGamma
PngGamma (Double -> PngGamma) -> (Word32 -> Double) -> Word32 -> PngGamma
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100000) (Double -> Double) -> (Word32 -> Double) -> Word32 -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> PngGamma) -> Get Word32 -> Get PngGamma
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32be
  put :: PngGamma -> Put
put = Word32 -> Put
putWord32be (Word32 -> Put) -> (PngGamma -> Word32) -> PngGamma -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Word32) -> (PngGamma -> Double) -> PngGamma -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double
100000 Double -> Double -> Double
forall a. Num a => a -> a -> a
*) (Double -> Double) -> (PngGamma -> Double) -> PngGamma -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PngGamma -> Double
getPngGamma 

data APngAnimationControl = APngAnimationControl
    { APngAnimationControl -> Word32
animationFrameCount :: !Word32
    , APngAnimationControl -> Word32
animationPlayCount  :: !Word32
    }
    deriving Int -> APngAnimationControl -> ShowS
[APngAnimationControl] -> ShowS
APngAnimationControl -> String
(Int -> APngAnimationControl -> ShowS)
-> (APngAnimationControl -> String)
-> ([APngAnimationControl] -> ShowS)
-> Show APngAnimationControl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [APngAnimationControl] -> ShowS
$cshowList :: [APngAnimationControl] -> ShowS
show :: APngAnimationControl -> String
$cshow :: APngAnimationControl -> String
showsPrec :: Int -> APngAnimationControl -> ShowS
$cshowsPrec :: Int -> APngAnimationControl -> ShowS
Show

-- | Encoded in a Word8

data APngFrameDisposal
      -- | No disposal is done on this frame before rendering the

      -- next; the contents of the output buffer are left as is. 

      -- Has Value 0

    = APngDisposeNone
      -- | The frame's region of the output buffer is to be cleared

      -- to fully transparent black before rendering the next frame. 

      -- Has Value 1

    | APngDisposeBackground
      -- | the frame's region of the output buffer is to be reverted

      -- to the previous contents before rendering the next frame.

      -- Has Value 2

    | APngDisposePrevious 
    deriving Int -> APngFrameDisposal -> ShowS
[APngFrameDisposal] -> ShowS
APngFrameDisposal -> String
(Int -> APngFrameDisposal -> ShowS)
-> (APngFrameDisposal -> String)
-> ([APngFrameDisposal] -> ShowS)
-> Show APngFrameDisposal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [APngFrameDisposal] -> ShowS
$cshowList :: [APngFrameDisposal] -> ShowS
show :: APngFrameDisposal -> String
$cshow :: APngFrameDisposal -> String
showsPrec :: Int -> APngFrameDisposal -> ShowS
$cshowsPrec :: Int -> APngFrameDisposal -> ShowS
Show

-- | Encoded in a Word8

data APngBlendOp
      -- | Overwrite output buffer. has value '0'

    = APngBlendSource
      -- | Alpha blend to the output buffer. Has value '1'

    | APngBlendOver
    deriving Int -> APngBlendOp -> ShowS
[APngBlendOp] -> ShowS
APngBlendOp -> String
(Int -> APngBlendOp -> ShowS)
-> (APngBlendOp -> String)
-> ([APngBlendOp] -> ShowS)
-> Show APngBlendOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [APngBlendOp] -> ShowS
$cshowList :: [APngBlendOp] -> ShowS
show :: APngBlendOp -> String
$cshow :: APngBlendOp -> String
showsPrec :: Int -> APngBlendOp -> ShowS
$cshowsPrec :: Int -> APngBlendOp -> ShowS
Show

data APngFrameControl = APngFrameControl
    { APngFrameControl -> Word32
frameSequenceNum      :: !Word32 -- ^ Starting from 0

    , APngFrameControl -> Word32
frameWidth            :: !Word32 -- ^ Width of the following frame

    , APngFrameControl -> Word32
frameHeight           :: !Word32 -- ^ Height of the following frame

    , APngFrameControl -> Word32
frameLeft             :: !Word32 -- X position where to render the frame.

    , APngFrameControl -> Word32
frameTop              :: !Word32 -- Y position where to render the frame.

    , APngFrameControl -> Word16
frameDelayNumerator   :: !Word16
    , APngFrameControl -> Word16
frameDelayDenuminator :: !Word16
    , APngFrameControl -> APngFrameDisposal
frameDisposal         :: !APngFrameDisposal
    , APngFrameControl -> APngBlendOp
frameBlending         :: !APngBlendOp
    }
    deriving Int -> APngFrameControl -> ShowS
[APngFrameControl] -> ShowS
APngFrameControl -> String
(Int -> APngFrameControl -> ShowS)
-> (APngFrameControl -> String)
-> ([APngFrameControl] -> ShowS)
-> Show APngFrameControl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [APngFrameControl] -> ShowS
$cshowList :: [APngFrameControl] -> ShowS
show :: APngFrameControl -> String
$cshow :: APngFrameControl -> String
showsPrec :: Int -> APngFrameControl -> ShowS
$cshowsPrec :: Int -> APngFrameControl -> ShowS
Show

-- | What kind of information is encoded in the IDAT section

-- of the PngFile

data PngImageType =
      PngGreyscale
    | PngTrueColour
    | PngIndexedColor
    | PngGreyscaleWithAlpha
    | PngTrueColourWithAlpha
    deriving Int -> PngImageType -> ShowS
[PngImageType] -> ShowS
PngImageType -> String
(Int -> PngImageType -> ShowS)
-> (PngImageType -> String)
-> ([PngImageType] -> ShowS)
-> Show PngImageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PngImageType] -> ShowS
$cshowList :: [PngImageType] -> ShowS
show :: PngImageType -> String
$cshow :: PngImageType -> String
showsPrec :: Int -> PngImageType -> ShowS
$cshowsPrec :: Int -> PngImageType -> ShowS
Show

-- | Raw parsed image which need to be decoded.

data PngRawImage = PngRawImage
    { PngRawImage -> PngIHdr
header       :: PngIHdr
    , PngRawImage -> [PngRawChunk]
chunks       :: [PngRawChunk]
    }

-- | Palette with indices beginning at 0 to elemcount - 1

type PngPalette = Palette' PixelRGB8

-- | Parse a palette from a png chunk.

parsePalette :: PngRawChunk -> Either String PngPalette
parsePalette :: PngRawChunk -> Either String PngPalette
parsePalette PngRawChunk
plte
 | PngRawChunk -> Word32
chunkLength PngRawChunk
plte Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`mod` Word32
3 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0 = String -> Either String PngPalette
forall a b. a -> Either a b
Left String
"Invalid palette size"
 | Bool
otherwise = Int -> Vector (PixelBaseComponent PixelRGB8) -> PngPalette
forall px. Int -> Vector (PixelBaseComponent px) -> Palette' px
Palette' Int
pixelCount (Vector Word8 -> PngPalette)
-> ([Word8] -> Vector Word8) -> [Word8] -> PngPalette
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word8] -> Vector Word8
forall a. Storable a => Int -> [a] -> Vector a
V.fromListN (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
pixelCount) ([Word8] -> PngPalette)
-> Either String [Word8] -> Either String PngPalette
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String [Word8]
pixels
    where pixelUnpacker :: Get [Word8]
pixelUnpacker = Int -> Get Word8 -> Get [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pixelCount Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3) Get Word8
forall t. Binary t => Get t
get
          pixelCount :: Int
pixelCount = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ PngRawChunk -> Word32
chunkLength PngRawChunk
plte Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
3
          pixels :: Either String [Word8]
pixels = Get [Word8] -> ByteString -> Either String [Word8]
forall a. Get a -> ByteString -> Either String a
runGet Get [Word8]
pixelUnpacker (PngRawChunk -> ByteString
chunkData PngRawChunk
plte)

-- | Data structure during real png loading/parsing

data PngRawChunk = PngRawChunk
    { PngRawChunk -> Word32
chunkLength :: Word32
    , PngRawChunk -> ByteString
chunkType   :: ChunkSignature
    , PngRawChunk -> Word32
chunkCRC    :: Word32
    , PngRawChunk -> ByteString
chunkData   :: L.ByteString
    }

mkRawChunk :: ChunkSignature -> L.ByteString -> PngRawChunk
mkRawChunk :: ByteString -> ByteString -> PngRawChunk
mkRawChunk ByteString
sig ByteString
binaryData = PngRawChunk :: Word32 -> ByteString -> Word32 -> ByteString -> PngRawChunk
PngRawChunk
  { chunkLength :: Word32
chunkLength = Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word32) -> Int64 -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
L.length ByteString
binaryData
  , chunkType :: ByteString
chunkType   = ByteString
sig
  , chunkCRC :: Word32
chunkCRC    = [ByteString] -> Word32
pngComputeCrc [ByteString
sig, ByteString
binaryData]
  , chunkData :: ByteString
chunkData   = ByteString
binaryData
  }

-- | PNG chunk representing some extra information found in the parsed file.

data PngChunk = PngChunk
    { PngChunk -> ByteString
pngChunkData        :: L.ByteString  -- ^ The raw data inside the chunk

    , PngChunk -> ByteString
pngChunkSignature   :: ChunkSignature -- ^ The name of the chunk.

    }

-- | Low level access to PNG information

data PngLowLevel a = PngLowLevel
    { PngLowLevel a -> Image a
pngImage  :: Image a      -- ^ The real uncompressed image

    , PngLowLevel a -> [PngChunk]
pngChunks :: [PngChunk]   -- ^ List of raw chunk where some user data might be present.

    }

-- | The pixels value should be :

-- +---+---+

-- | c | b |

-- +---+---+

-- | a | x |

-- +---+---+

-- x being the current filtered pixel

data PngFilter =
    -- | Filt(x) = Orig(x), Recon(x) = Filt(x)

      FilterNone
    -- | Filt(x) = Orig(x) - Orig(a),     Recon(x) = Filt(x) + Recon(a)

    | FilterSub
    -- | Filt(x) = Orig(x) - Orig(b),     Recon(x) = Filt(x) + Recon(b)

    | FilterUp
    -- | Filt(x) = Orig(x) - floor((Orig(a) + Orig(b)) / 2),

    -- Recon(x) = Filt(x) + floor((Recon(a) + Recon(b)) / 2)

    | FilterAverage
    -- | Filt(x) = Orig(x) - PaethPredictor(Orig(a), Orig(b), Orig(c)),

    -- Recon(x) = Filt(x) + PaethPredictor(Recon(a), Recon(b), Recon(c))

    | FilterPaeth
    deriving (Int -> PngFilter
PngFilter -> Int
PngFilter -> [PngFilter]
PngFilter -> PngFilter
PngFilter -> PngFilter -> [PngFilter]
PngFilter -> PngFilter -> PngFilter -> [PngFilter]
(PngFilter -> PngFilter)
-> (PngFilter -> PngFilter)
-> (Int -> PngFilter)
-> (PngFilter -> Int)
-> (PngFilter -> [PngFilter])
-> (PngFilter -> PngFilter -> [PngFilter])
-> (PngFilter -> PngFilter -> [PngFilter])
-> (PngFilter -> PngFilter -> PngFilter -> [PngFilter])
-> Enum PngFilter
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PngFilter -> PngFilter -> PngFilter -> [PngFilter]
$cenumFromThenTo :: PngFilter -> PngFilter -> PngFilter -> [PngFilter]
enumFromTo :: PngFilter -> PngFilter -> [PngFilter]
$cenumFromTo :: PngFilter -> PngFilter -> [PngFilter]
enumFromThen :: PngFilter -> PngFilter -> [PngFilter]
$cenumFromThen :: PngFilter -> PngFilter -> [PngFilter]
enumFrom :: PngFilter -> [PngFilter]
$cenumFrom :: PngFilter -> [PngFilter]
fromEnum :: PngFilter -> Int
$cfromEnum :: PngFilter -> Int
toEnum :: Int -> PngFilter
$ctoEnum :: Int -> PngFilter
pred :: PngFilter -> PngFilter
$cpred :: PngFilter -> PngFilter
succ :: PngFilter -> PngFilter
$csucc :: PngFilter -> PngFilter
Enum, Int -> PngFilter -> ShowS
[PngFilter] -> ShowS
PngFilter -> String
(Int -> PngFilter -> ShowS)
-> (PngFilter -> String)
-> ([PngFilter] -> ShowS)
-> Show PngFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PngFilter] -> ShowS
$cshowList :: [PngFilter] -> ShowS
show :: PngFilter -> String
$cshow :: PngFilter -> String
showsPrec :: Int -> PngFilter -> ShowS
$cshowsPrec :: Int -> PngFilter -> ShowS
Show)

-- | Different known interlace methods for PNG image

data PngInterlaceMethod =
      -- | No interlacing, basic data ordering, line by line

      -- from left to right.

      PngNoInterlace

      -- | Use the Adam7 ordering, see `adam7Reordering`

    | PngInterlaceAdam7
    deriving (Int -> PngInterlaceMethod
PngInterlaceMethod -> Int
PngInterlaceMethod -> [PngInterlaceMethod]
PngInterlaceMethod -> PngInterlaceMethod
PngInterlaceMethod -> PngInterlaceMethod -> [PngInterlaceMethod]
PngInterlaceMethod
-> PngInterlaceMethod -> PngInterlaceMethod -> [PngInterlaceMethod]
(PngInterlaceMethod -> PngInterlaceMethod)
-> (PngInterlaceMethod -> PngInterlaceMethod)
-> (Int -> PngInterlaceMethod)
-> (PngInterlaceMethod -> Int)
-> (PngInterlaceMethod -> [PngInterlaceMethod])
-> (PngInterlaceMethod
    -> PngInterlaceMethod -> [PngInterlaceMethod])
-> (PngInterlaceMethod
    -> PngInterlaceMethod -> [PngInterlaceMethod])
-> (PngInterlaceMethod
    -> PngInterlaceMethod
    -> PngInterlaceMethod
    -> [PngInterlaceMethod])
-> Enum PngInterlaceMethod
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PngInterlaceMethod
-> PngInterlaceMethod -> PngInterlaceMethod -> [PngInterlaceMethod]
$cenumFromThenTo :: PngInterlaceMethod
-> PngInterlaceMethod -> PngInterlaceMethod -> [PngInterlaceMethod]
enumFromTo :: PngInterlaceMethod -> PngInterlaceMethod -> [PngInterlaceMethod]
$cenumFromTo :: PngInterlaceMethod -> PngInterlaceMethod -> [PngInterlaceMethod]
enumFromThen :: PngInterlaceMethod -> PngInterlaceMethod -> [PngInterlaceMethod]
$cenumFromThen :: PngInterlaceMethod -> PngInterlaceMethod -> [PngInterlaceMethod]
enumFrom :: PngInterlaceMethod -> [PngInterlaceMethod]
$cenumFrom :: PngInterlaceMethod -> [PngInterlaceMethod]
fromEnum :: PngInterlaceMethod -> Int
$cfromEnum :: PngInterlaceMethod -> Int
toEnum :: Int -> PngInterlaceMethod
$ctoEnum :: Int -> PngInterlaceMethod
pred :: PngInterlaceMethod -> PngInterlaceMethod
$cpred :: PngInterlaceMethod -> PngInterlaceMethod
succ :: PngInterlaceMethod -> PngInterlaceMethod
$csucc :: PngInterlaceMethod -> PngInterlaceMethod
Enum, Int -> PngInterlaceMethod -> ShowS
[PngInterlaceMethod] -> ShowS
PngInterlaceMethod -> String
(Int -> PngInterlaceMethod -> ShowS)
-> (PngInterlaceMethod -> String)
-> ([PngInterlaceMethod] -> ShowS)
-> Show PngInterlaceMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PngInterlaceMethod] -> ShowS
$cshowList :: [PngInterlaceMethod] -> ShowS
show :: PngInterlaceMethod -> String
$cshow :: PngInterlaceMethod -> String
showsPrec :: Int -> PngInterlaceMethod -> ShowS
$cshowsPrec :: Int -> PngInterlaceMethod -> ShowS
Show)

--------------------------------------------------

----            Instances

--------------------------------------------------

instance Binary PngFilter where
    put :: PngFilter -> Put
put = Word8 -> Put
putWord8 (Word8 -> Put) -> (PngFilter -> Word8) -> PngFilter -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a. Enum a => Int -> a
toEnum (Int -> Word8) -> (PngFilter -> Int) -> PngFilter -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PngFilter -> Int
forall a. Enum a => a -> Int
fromEnum
    get :: Get PngFilter
get = Get Word8
getWord8 Get Word8 -> (Word8 -> Get PngFilter) -> Get PngFilter
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
w -> case Word8
w of
        Word8
0 -> PngFilter -> Get PngFilter
forall (m :: * -> *) a. Monad m => a -> m a
return PngFilter
FilterNone
        Word8
1 -> PngFilter -> Get PngFilter
forall (m :: * -> *) a. Monad m => a -> m a
return PngFilter
FilterSub
        Word8
2 -> PngFilter -> Get PngFilter
forall (m :: * -> *) a. Monad m => a -> m a
return PngFilter
FilterUp
        Word8
3 -> PngFilter -> Get PngFilter
forall (m :: * -> *) a. Monad m => a -> m a
return PngFilter
FilterAverage
        Word8
4 -> PngFilter -> Get PngFilter
forall (m :: * -> *) a. Monad m => a -> m a
return PngFilter
FilterPaeth
        Word8
_ -> String -> Get PngFilter
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid scanline filter"

instance Binary PngRawImage where
    put :: PngRawImage -> Put
put PngRawImage
img = do
        ByteString -> Put
putLazyByteString ByteString
pngSignature
        PngIHdr -> Put
forall t. Binary t => t -> Put
put (PngIHdr -> Put) -> PngIHdr -> Put
forall a b. (a -> b) -> a -> b
$ PngRawImage -> PngIHdr
header PngRawImage
img
        (PngRawChunk -> Put) -> [PngRawChunk] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PngRawChunk -> Put
forall t. Binary t => t -> Put
put ([PngRawChunk] -> Put) -> [PngRawChunk] -> Put
forall a b. (a -> b) -> a -> b
$ PngRawImage -> [PngRawChunk]
chunks PngRawImage
img

    get :: Get PngRawImage
get = Get PngRawImage
parseRawPngImage

instance Binary PngRawChunk where
    put :: PngRawChunk -> Put
put PngRawChunk
chunk = do
        Word32 -> Put
putWord32be (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ PngRawChunk -> Word32
chunkLength PngRawChunk
chunk
        ByteString -> Put
putLazyByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ PngRawChunk -> ByteString
chunkType PngRawChunk
chunk
        Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PngRawChunk -> Word32
chunkLength PngRawChunk
chunk Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0)
             (ByteString -> Put
putLazyByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ PngRawChunk -> ByteString
chunkData PngRawChunk
chunk)
        Word32 -> Put
putWord32be (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ PngRawChunk -> Word32
chunkCRC PngRawChunk
chunk

    get :: Get PngRawChunk
get = do
        Word32
size <- Get Word32
getWord32be
        ByteString
chunkSig <- Int64 -> Get ByteString
getLazyByteString (Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
L.length ByteString
iHDRSignature)
        ByteString
imgData <- if Word32
size Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0
            then ByteString -> Get ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
L.empty
            else Int64 -> Get ByteString
getLazyByteString (Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size)
        Word32
crc <- Get Word32
getWord32be

        let computedCrc :: Word32
computedCrc = [ByteString] -> Word32
pngComputeCrc [ByteString
chunkSig, ByteString
imgData]
        Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
computedCrc Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
crc Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0)
             (String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"Invalid CRC : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
computedCrc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", "
                                      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
crc)
        PngRawChunk -> Get PngRawChunk
forall (m :: * -> *) a. Monad m => a -> m a
return PngRawChunk :: Word32 -> ByteString -> Word32 -> ByteString -> PngRawChunk
PngRawChunk {
            chunkLength :: Word32
chunkLength = Word32
size,
            chunkData :: ByteString
chunkData = ByteString
imgData,
            chunkCRC :: Word32
chunkCRC = Word32
crc,
            chunkType :: ByteString
chunkType = ByteString
chunkSig
        }

instance Binary PngIHdr where
    put :: PngIHdr -> Put
put PngIHdr
hdr = do
        Word32 -> Put
putWord32be Word32
13
        let inner :: ByteString
inner = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
                ByteString -> Put
putLazyByteString ByteString
iHDRSignature
                Word32 -> Put
putWord32be (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ PngIHdr -> Word32
width PngIHdr
hdr
                Word32 -> Put
putWord32be (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ PngIHdr -> Word32
height PngIHdr
hdr
                Word8 -> Put
putWord8    (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ PngIHdr -> Word8
bitDepth PngIHdr
hdr
                PngImageType -> Put
forall t. Binary t => t -> Put
put (PngImageType -> Put) -> PngImageType -> Put
forall a b. (a -> b) -> a -> b
$ PngIHdr -> PngImageType
colourType PngIHdr
hdr
                Word8 -> Put
forall t. Binary t => t -> Put
put (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ PngIHdr -> Word8
compressionMethod PngIHdr
hdr
                Word8 -> Put
forall t. Binary t => t -> Put
put (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ PngIHdr -> Word8
filterMethod PngIHdr
hdr
                PngInterlaceMethod -> Put
forall t. Binary t => t -> Put
put (PngInterlaceMethod -> Put) -> PngInterlaceMethod -> Put
forall a b. (a -> b) -> a -> b
$ PngIHdr -> PngInterlaceMethod
interlaceMethod PngIHdr
hdr
            crc :: Word32
crc = [ByteString] -> Word32
pngComputeCrc [ByteString
inner]
        ByteString -> Put
putLazyByteString ByteString
inner
        Word32 -> Put
putWord32be Word32
crc

    get :: Get PngIHdr
get = do
        Word32
_size <- Get Word32
getWord32be
        ByteString
ihdrSig <- Int64 -> Get ByteString
getLazyByteString (ByteString -> Int64
L.length ByteString
iHDRSignature)
        Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
ihdrSig ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
iHDRSignature)
             (String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid PNG file, wrong ihdr")
        Word32
w <- Get Word32
getWord32be
        Word32
h <- Get Word32
getWord32be
        Word8
depth <- Get Word8
forall t. Binary t => Get t
get
        PngImageType
colorType <- Get PngImageType
forall t. Binary t => Get t
get
        Word8
compression <- Get Word8
forall t. Binary t => Get t
get
        Word8
filtermethod <- Get Word8
forall t. Binary t => Get t
get
        PngInterlaceMethod
interlace <- Get PngInterlaceMethod
forall t. Binary t => Get t
get
        Word32
_crc <- Get Word32
getWord32be
        PngIHdr -> Get PngIHdr
forall (m :: * -> *) a. Monad m => a -> m a
return PngIHdr :: Word32
-> Word32
-> Word8
-> PngImageType
-> Word8
-> Word8
-> PngInterlaceMethod
-> PngIHdr
PngIHdr {
            width :: Word32
width = Word32
w,
            height :: Word32
height = Word32
h,
            bitDepth :: Word8
bitDepth = Word8
depth,
            colourType :: PngImageType
colourType = PngImageType
colorType,
            compressionMethod :: Word8
compressionMethod = Word8
compression,
            filterMethod :: Word8
filterMethod = Word8
filtermethod,
            interlaceMethod :: PngInterlaceMethod
interlaceMethod = PngInterlaceMethod
interlace
        }

-- | Parse method for a png chunk, without decompression.

parseChunks :: Get [PngRawChunk]
parseChunks :: Get [PngRawChunk]
parseChunks = do
    PngRawChunk
chunk <- Get PngRawChunk
forall t. Binary t => Get t
get

    if PngRawChunk -> ByteString
chunkType PngRawChunk
chunk ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
iENDSignature
       then [PngRawChunk] -> Get [PngRawChunk]
forall (m :: * -> *) a. Monad m => a -> m a
return [PngRawChunk
chunk]
       else (PngRawChunk
chunkPngRawChunk -> [PngRawChunk] -> [PngRawChunk]
forall a. a -> [a] -> [a]
:) ([PngRawChunk] -> [PngRawChunk])
-> Get [PngRawChunk] -> Get [PngRawChunk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [PngRawChunk]
parseChunks


instance Binary PngInterlaceMethod where
    get :: Get PngInterlaceMethod
get = Get Word8
getWord8 Get Word8
-> (Word8 -> Get PngInterlaceMethod) -> Get PngInterlaceMethod
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
w -> case Word8
w of
        Word8
0 -> PngInterlaceMethod -> Get PngInterlaceMethod
forall (m :: * -> *) a. Monad m => a -> m a
return PngInterlaceMethod
PngNoInterlace
        Word8
1 -> PngInterlaceMethod -> Get PngInterlaceMethod
forall (m :: * -> *) a. Monad m => a -> m a
return PngInterlaceMethod
PngInterlaceAdam7
        Word8
_ -> String -> Get PngInterlaceMethod
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid interlace method"

    put :: PngInterlaceMethod -> Put
put PngInterlaceMethod
PngNoInterlace    = Word8 -> Put
putWord8 Word8
0
    put PngInterlaceMethod
PngInterlaceAdam7 = Word8 -> Put
putWord8 Word8
1

-- | Implementation of the get method for the PngRawImage,

-- unpack raw data, without decompressing it.

parseRawPngImage :: Get PngRawImage
parseRawPngImage :: Get PngRawImage
parseRawPngImage = do
    ByteString
sig <- Int64 -> Get ByteString
getLazyByteString (ByteString -> Int64
L.length ByteString
pngSignature)
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
sig ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
pngSignature)
         (String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid PNG file, signature broken")

    PngIHdr
ihdr <- Get PngIHdr
forall t. Binary t => Get t
get

    [PngRawChunk]
chunkList <- Get [PngRawChunk]
parseChunks
    PngRawImage -> Get PngRawImage
forall (m :: * -> *) a. Monad m => a -> m a
return PngRawImage :: PngIHdr -> [PngRawChunk] -> PngRawImage
PngRawImage { header :: PngIHdr
header = PngIHdr
ihdr, chunks :: [PngRawChunk]
chunks = [PngRawChunk]
chunkList }

--------------------------------------------------

----            functions

--------------------------------------------------


-- | Signature signalling that the following data will be a png image

-- in the png bit stream

pngSignature :: ChunkSignature
pngSignature :: ByteString
pngSignature = [Word8] -> ByteString
L.pack [Word8
137, Word8
80, Word8
78, Word8
71, Word8
13, Word8
10, Word8
26, Word8
10]

-- | Helper function to help pack signatures.

signature :: String -> ChunkSignature
signature :: String -> ByteString
signature = String -> ByteString
LS.pack 

-- | Signature for the header chunk of png (must be the first)

iHDRSignature :: ChunkSignature 
iHDRSignature :: ByteString
iHDRSignature = String -> ByteString
signature String
"IHDR"

-- | Signature for a palette chunk in the pgn file. Must

-- occure before iDAT.

pLTESignature :: ChunkSignature
pLTESignature :: ByteString
pLTESignature = String -> ByteString
signature String
"PLTE"

-- | Signature for a data chuck (with image parts in it)

iDATSignature :: ChunkSignature
iDATSignature :: ByteString
iDATSignature = String -> ByteString
signature String
"IDAT"

-- | Signature for the last chunk of a png image, telling

-- the end.

iENDSignature :: ChunkSignature
iENDSignature :: ByteString
iENDSignature = String -> ByteString
signature String
"IEND"

tRNSSignature :: ChunkSignature
tRNSSignature :: ByteString
tRNSSignature = String -> ByteString
signature String
"tRNS"

gammaSignature :: ChunkSignature
gammaSignature :: ByteString
gammaSignature = String -> ByteString
signature String
"gAMA"

pHYsSignature :: ChunkSignature
pHYsSignature :: ByteString
pHYsSignature = String -> ByteString
signature String
"pHYs"

tEXtSignature :: ChunkSignature
tEXtSignature :: ByteString
tEXtSignature = String -> ByteString
signature String
"tEXt"

zTXtSignature :: ChunkSignature
zTXtSignature :: ByteString
zTXtSignature = String -> ByteString
signature String
"zTXt"

animationControlSignature :: ChunkSignature
animationControlSignature :: ByteString
animationControlSignature = String -> ByteString
signature String
"acTL"

instance Binary PngImageType where
    put :: PngImageType -> Put
put PngImageType
PngGreyscale = Word8 -> Put
putWord8 Word8
0
    put PngImageType
PngTrueColour = Word8 -> Put
putWord8 Word8
2
    put PngImageType
PngIndexedColor = Word8 -> Put
putWord8 Word8
3
    put PngImageType
PngGreyscaleWithAlpha = Word8 -> Put
putWord8 Word8
4
    put PngImageType
PngTrueColourWithAlpha = Word8 -> Put
putWord8 Word8
6

    get :: Get PngImageType
get = Get Word8
forall t. Binary t => Get t
get Get Word8 -> (Word8 -> Get PngImageType) -> Get PngImageType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get PngImageType
imageTypeOfCode

imageTypeOfCode :: Word8 -> Get PngImageType
imageTypeOfCode :: Word8 -> Get PngImageType
imageTypeOfCode Word8
0 = PngImageType -> Get PngImageType
forall (m :: * -> *) a. Monad m => a -> m a
return PngImageType
PngGreyscale
imageTypeOfCode Word8
2 = PngImageType -> Get PngImageType
forall (m :: * -> *) a. Monad m => a -> m a
return PngImageType
PngTrueColour
imageTypeOfCode Word8
3 = PngImageType -> Get PngImageType
forall (m :: * -> *) a. Monad m => a -> m a
return PngImageType
PngIndexedColor
imageTypeOfCode Word8
4 = PngImageType -> Get PngImageType
forall (m :: * -> *) a. Monad m => a -> m a
return PngImageType
PngGreyscaleWithAlpha
imageTypeOfCode Word8
6 = PngImageType -> Get PngImageType
forall (m :: * -> *) a. Monad m => a -> m a
return PngImageType
PngTrueColourWithAlpha
imageTypeOfCode Word8
_ = String -> Get PngImageType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid png color code"

-- | From the Annex D of the png specification.

pngCrcTable :: Vector Word32
pngCrcTable :: Vector Word32
pngCrcTable = Int -> [Word32] -> Vector Word32
forall a. Unbox a => Int -> [a] -> Vector a
fromListN Int
256 [ (Word32 -> Int -> Word32) -> Word32 -> [Int] -> Word32
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Word32 -> Int -> Word32
forall p. Word32 -> p -> Word32
updateCrcConstant Word32
c [Int
zero .. Int
7] | Word32
c <- [Word32
0 .. Word32
255] ]
    where zero :: Int
zero = Int
0 :: Int -- To avoid defaulting to Integer

          updateCrcConstant :: Word32 -> p -> Word32
updateCrcConstant Word32
c p
_ | Word32
c Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
1 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0 = Word32
magicConstant Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
c Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1)
                                | Bool
otherwise = Word32
c Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1
          magicConstant :: Word32
magicConstant = Word32
0xedb88320 :: Word32

-- | Compute the CRC of a raw buffer, as described in annex D of the PNG

-- specification.

pngComputeCrc :: [L.ByteString] -> Word32
pngComputeCrc :: [ByteString] -> Word32
pngComputeCrc = (Word32
0xFFFFFFFF Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor`) (Word32 -> Word32)
-> ([ByteString] -> Word32) -> [ByteString] -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Word8 -> Word32) -> Word32 -> ByteString -> Word32
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
L.foldl' Word32 -> Word8 -> Word32
forall a. Integral a => Word32 -> a -> Word32
updateCrc Word32
0xFFFFFFFF (ByteString -> Word32)
-> ([ByteString] -> ByteString) -> [ByteString] -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
L.concat
    where updateCrc :: Word32 -> a -> Word32
updateCrc Word32
crc a
val =
              let u32Val :: Word32
u32Val = a -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
val
                  lutVal :: Word32
lutVal = Vector Word32
pngCrcTable Vector Word32 -> Int -> Word32
forall a. Unbox a => Vector a -> Int -> a
! (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
crc Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` Word32
u32Val) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF))
              in Word32
lutVal Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
`xor` (Word32
crc Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
8)

chunksWithSig :: PngRawImage -> ChunkSignature -> [LS.ByteString]
chunksWithSig :: PngRawImage -> ByteString -> [ByteString]
chunksWithSig PngRawImage
rawImg ByteString
sig =
  [PngRawChunk -> ByteString
chunkData PngRawChunk
chunk | PngRawChunk
chunk <- PngRawImage -> [PngRawChunk]
chunks PngRawImage
rawImg, PngRawChunk -> ByteString
chunkType PngRawChunk
chunk ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
sig]