module PNG2PNM(png2pnm) where
import Data.Array
import Utils2(pieces)
import Byte(unpack)
import PNG
import PNM
import PNGinterlace(adam7passesPost,adam7deinterlace)

default (Int)

png2pnm (PNG ihdr (PLTE plte) bkgd trans idata) =
    PNM size $
    case colorType ihdr of
      GreyScale | bd==1 -> PBM (map (==0) pixels)
            | otherwise -> PGM max pixels
                   where pixels = du (bytes2samples bd) idata
      Truecolor         -> PPM max (du (bytes2rgbs bd) idata)
      IndexedColor
            | ixtrans   -> PPM 255 (uac(du (map rgba . bytes2samples bd) idata))
            | otherwise -> PPM 255 (du (map (cmap!) . bytes2samples bd) idata)
      GreyScaleWithAlpha -> PGM max (uag ((du bytes2ga idata)))
      TruecolorWithAlpha -> PPM max (uac (du (bytes2rgbas bd) idata))
  where
    w = width ihdr
    size = (w,height ihdr)
    bd = bitDepth ihdr
    p = pitch ihdr
    max = 2^bd-1

    rgba ix = Alpha (cmap ! ix) (if ix<=tmax then tmap ! ix else 255)
    cmap = listArray (0,length plte-1) (map (fmap fromEnum) plte)
    (_,tmax) = bounds tmap
    (ixtrans,tmap) =
        case trans of
          IxTrans as -> (True,listArray (0,length as-1) (map fromEnum as))
          _          -> (False,undefined)

    bytes2ga = withAlpha . bytes2samples bd

    withAlpha (g:a:gas) = Alpha g a:withAlpha gas
    withAlpha _ = []

    uag = map (unAlpha bgg)
    uac = map (unAlpha bgc)
    unAlpha bg (Alpha c a) = if a==0 then bg else c -- !! quick hack

    bgc = case bkgd of
            IxBg ix -> cmap ! fromEnum ix
            TruecolorBg rgb -> fmap fromEnum rgb
            _ -> RGB 0xc0 0xc0 0xc0

    bgg = case bkgd of
            GreyBg bg -> fromEnum bg
            _ -> 0xc0

    -- unpad and deinterlace
    du = deinterlace
    deinterlace bs2ps =
      case interlaceMethod ihdr of
        NoInterlace -> unpad1 bs2ps
        Adam7 -> adam7deinterlace size .
                 concatMap (uncurry (unpad2 bs2ps)) .
                 adam7passesPost ihdr 

    -- Do the pixels fill complete bytes or was the scanline padded?
    padded w = (w*ibpp) `rem` 8 /= 0
    ibpp = bpp ihdr

    unpad1 bs2ps | padded w  = unpad' bs2ps w . pieces p
                 | otherwise = bs2ps

    unpad2 bs2ps w | padded w  = unpad' bs2ps w 
                   | otherwise = concatMap bs2ps

    unpad' bs2ps w = concatMap (take w . bs2ps)

data Trans c a = Alpha !c !a

bytes2rgbs bd = samples2rgbs . bytes2samples bd
bytes2rgbas bd = samples2rgbas . bytes2samples bd

samples2rgbs (r:g:b:ss) = RGB r g b:samples2rgbs ss
samples2rgbs _ = []

samples2rgbas (r:g:b:a:ss) = Alpha (RGB r g b) a:samples2rgbas ss
samples2rgbas _ = []

bytes2samples bd = bytes2samples' bd . unpack

bytes2samples' :: Depth -> [Byte] -> [Int]
bytes2samples' bd =
  case bd of
    16 -> bytes2words
    8 -> map fromEnum
    4 -> concatMap (splitByte 4)
    2 -> concatMap (splitByte 2)
    1 -> concatMap (splitByte 1)

splitByte k byte = split 8 [] (fromEnum byte)
  where
    e = 2^k
    split 0 bs byte = bs
    split n bs byte = split (n-k) (byte `rem` e:bs) (byte `quot` e)

bytes2words (hi:lo:bs) = 256*fromEnum hi+fromEnum lo:bytes2words bs
bytes2words _ = []