module File.Binary.PNG.Chunks.Each (
IHDR(..), PLTE(..), RGB8(..), IDAT(..), IEND(..),
TRNS,
CHRM(..), GAMA(..), ICCP(..), SBIT, SRGB(..),
ITXT, TEXT(..), ZTXT,
BKGD(..), HIST, PHYS, SPLT, TIME,
DATA(..),
chunkNames, critical, beforePLTE, beforeIDAT, anyPlace
) where
import Data.Monoid (mconcat)
import Data.ByteString.Lazy (ByteString, append)
import File.Binary (binary, Field(..), Binary(..))
import File.Binary.Instances ()
import File.Binary.Instances.BigEndian ()
import File.Binary.Instances.MSB0 ()
import qualified Data.ByteString.Lazy.Char8 as BSLC
chunkNames, critical, beforePLTE, beforeIDAT, anyPlace :: [String]
chunkNames = critical ++ beforePLTE ++ beforeIDAT ++ anyPlace
critical = ["IHDR", "PLTE", "IDAT", "IEND"]
beforePLTE = ["cHRM", "gAMA", "iCCP", "sBIT", "sRGB", "bKGD", "hIST", "tRNS"]
beforeIDAT = ["pHYs", "sPLT"]
anyPlace = ["tIME", "iTXt", "tEXt", "zTXt"]
type TRNS = DATA
type SBIT = DATA
type ITXT = DATA
type ZTXT = DATA
type HIST = DATA
type PHYS = DATA
type SPLT = DATA
type TIME = DATA
[binary|
IHDR deriving Show
arg :: Int
4: width
4: height
1: depth
: False
: False
: False
: False
: False
{Bool}: alpha
{Bool}: color
{Bool}: palet
1: compressionType
1: filterType
1: interlaceType
|]
[binary|
PLTE deriving Show
arg :: Int
replicate (arg `div` 3) (){[RGB8]}: colors
|]
data RGB8 = RGB8 { red :: Int, green :: Int, blue :: Int } deriving Show
instance Field RGB8 where
type FieldArgument RGB8 = ()
toBinary () RGB8{ red = r, green = g, blue = b } = do
r' <- toBinary 1 r
g' <- toBinary 1 g
b' <- toBinary 1 b
return $ mconcat [r', g', b']
fromBinary () bin = do
(r, bin') <- fromBinary 1 bin
(g, bin'') <- fromBinary 1 bin'
(b, bin''') <- fromBinary 1 bin''
return (RGB8{ red = r, green = g, blue = b } , bin''')
[binary|
IDAT deriving Show
arg :: Int
arg{ByteString}: idat_body
|]
[binary|IEND deriving Show arg :: Int|]
[binary|
CHRM deriving Show
arg :: Int
replicate (arg `div` 4) 4{[Int]}: chrms
|]
[binary|
GAMA deriving Show
arg :: Int
4: gamma
|]
[binary|
ICCP deriving Show
arg :: Int
{NullString}: iccp_name
1: iccp_con
(arg length (nullString iccp_name) 2){ByteString}: iccp_body
|]
data NullString = NullString { nullString :: String } deriving Show
instance Field NullString where
type FieldArgument NullString = ()
toBinary () (NullString str) =
return $ makeBinary $ (`append` "\NUL") $ BSLC.pack str
fromBinary () bin = do
let (ret, rest) = spanBytes (/= 0) bin
return (NullString $ BSLC.unpack ret, snd $ unconsByte rest)
[binary|
SRGB deriving Show
arg :: Int
1: srgb
|]
[binary|
TEXT deriving Show
arg :: Int
replicate arg (){String}: text
|]
[binary|
BKGD deriving Show
arg :: Int
arg{ByteString}: bkgd
|]
[binary|
DATA deriving Show
arg :: Int
arg{ByteString}: dat
|]