unit PNG;

// FIXME finish.

{$MODE OBJFPC}
{$M+}
{$ASSERTIONS ON}

interface
uses type_fixes, loaders, classes, framebuffers, colors;

type
  // private:
  TIHDRChunk = record // FOURCC 'IHDR'.
    Width : 0..2^31 - 1;
    Height : 0..2^31 - 1; 
    BitDepth : TByte; {
   Color    Allowed    Interpretation
   Type    Bit Depths
   
   0       1,2,4,8,16  Each pixel is a grayscale sample.
   2       8,16        Each pixel is an R,G,B triple.
   3       1,2,4,8     Each pixel is a palette index;
   4       8,16        Each pixel is a grayscale sample,
                       followed by an alpha sample.
   6       8,16        Each pixel is an R,G,B triple,
                       followed by an alpha sample.
    }
    ColorType : TByte; // sums of the following values: 1 (palette used), 2 (color used), and 4 (alpha channel used). Valid values are 0, 2, 3, 4, and 6. 
    CompressionMethod : TByte; // deflate/inflate compression with a sliding window of at most 32768 bytes) is defined.
    FilterMethod : TByte; // 0 (adaptive filtering with five basic filter types).
    InterlaceMethod : TByte; // 0 (no interlace) or 1 (Adam7 interlace).
  end;

  // private...
  TScanline = array of TByte;
  TScanlineP = ^TScanline;

  { note that the pixmap info palette contains the GLOBAL palette of the file, which may not be what you expected... }
  TLoader = class(TInterfacedObject, ILoader, IInterface)
  private
    fStream : TStream;
    fBHeadersLoaded : TBoolean;
    //fInitialPosition : TINT64;
    fPixmapInfo : IPixmapInfo;
    fPixmapInfoR : TPixmapInfo;
    fIHDRChunk : TIHDRChunk;
    fBackgroundColor : IRGBColor;
    fPreviousRow : TScanlineP;
    fCurrentRow : TScanlineP;
    fRow1 : TScanline;
    fRow2 : TScanline;
    fPixelSizeBits : TByte; // in bits.
    fPixelSizeBytes : TByte; // rounded up, in bytes (i.e. not < 8).
    fImageDataStream : TStream;
    fRun : TRun;
  protected
    function GetHeaders() : IPixmapInfo;
    procedure EnsureIHDRLoaded(); inline;
    procedure ClearRow(); inline;
  public
    destructor Destroy(); override;
  published
    constructor Create(aStream : TStream);
    property Headers : IPixmapInfo read GetHeaders;
    function NextRun() : TRun;
  protected
    procedure LoadHeaders();
  end;
  
  // compositing:    output = alpha * foreground + (1-alpha) * background.
  
implementation
uses sysutils, {paszlib.}zstream, windowed_streams, loggers;

{$PACKRECORDS C}

type
  THeader = record
    Magic : array[0..7] of TByte; // hex: 89 50 4E 47 0D 0A 1A 0A.
  end;
  // series of Chunks. critical or ancillary.
  
  TChunkHeader = record
    DataSize : 0..2^31 - 1; // ONLY the data field, without type, CRC.
    ChunkType : TFOURCC;

    //The case of the first letter indicates if the chunk is critical or not. If the first letter is uppercase, the chunk is critical; if not, the chunk is ancillary
    //The case of the second letter indicates if the chunk is "public" (either in the specification or the registry of special purpose public chunks) or "private" (not standardised). Uppercase is public and lowercase is private. This ensures that public and private chunk names can never conflict with each other (although two private chunk names could conflict).
    //The third letter must be uppercase to conform to the PNG specification.
    //The case of the fourth letter indicates if a chunk is safe to copy by editors that do not recognize it. If lowercase, the chunk may be safely copied regardless of the extent of modifications to the file. If uppercase, it may only be copied if the modifications have not touched any critical chunks.

    //Data : ??
    //CRC: TUINT32; (including the type and data, not including the length).
    // CRC polynomial:    x^32+x^26+x^23+x^22+x^16+x^12+x^11+x^10+x^8+x^7+x^5+x^4+x^2+x+1
  end;
  
  
  TPLTEChunk = record // FOURCC 'PLTE'. This chunk must appear for color type 3, and can appear for color types 2 and 6; it must not appear for color types 0 and 4.
    Palette : array[0..255] of TPaletteEntry; // not neccessarily all of them are there.
  end;
  
  // TIDATChunk = record
  // TIENDChunk = record

  {
  T_iCCPChunk = record
    ProfileName : array[0..79] of Char;
    Null : TByte;
    CompresionMethod : TByte;
    CompressedProfile : n bytes;
  end;}

  {T_iTX_tChunk = record // UTF-8 ...
   Keyword:             1-79 bytes (character string)
   Null separator:      1 byte
   Compression flag:    1 byte
   Compression method:  1 byte
   Language tag:        0 or more bytes (character string)
   Null separator:      1 byte
   Translated keyword:  0 or more bytes
   Null separator:      1 byte
   Text:                0 or more bytes
  end;}
  
  {T_tEX_tChunk = record
      Keyword:        1-79 bytes (character string)
         Null separator: 1 byte
            Text:           n bytes (character string)
            
  end;}
  
  {T_zTX_tChunk = record
     Keyword:            1-79 bytes (character string)
        Null separator:     1 byte
           Compression method: 1 byte
              Compressed text:    n bytes
  end;}
  {
4.2.4.2. pHYs Physical pixel dimensions
  }

  // sBIT.

  
  { TODO other chunks:
    * bKGD gives the default background color. It is intended for use when there is no better choice available, such as in standalone image viewers (but not web browsers, see below for more details).
    * cHRM gives the white balance.
    * gAMA specifies gamma.
    * hIST can store the histogram, or total amount of each color in the image.
    * iCCP is an ICC color profile.
    * iTXt contains UTF-8 text, compressed or not, with an optional language tag.
    * pHYs holds the intended pixel size and/or aspect ratio of the image.
    * sBIT (significant bits) indicates the color-accuracy of the source data.
    * sPLT suggests a palette to use if the full range of colors is unavailable.
    * sRGB indicates that the standard sRGB color space is used.
    * tEXt can store text that can be represented in ISO 8859-1, with one name=value pair for each chunk.
    * tIME stores the time that the image was last changed.
    * tRNS contains transparency information. For indexed images, it stores alpha channel values for one or more palette entries. For truecolor and greyscale images, it stores a single pixel value that is to be regarded as fully transparent.
    * zTXt contains compressed text with the same limits as tEXt.
  }

function PixelSize(const aIHDRChunk : TIHDRChunk) : TByte; // in bits.
var
  vComponentCount : TByte;
begin
  with aIHDRChunk do begin
    case ColorType of
    0: vComponentCount := 1; // grayscale.
    2: vComponentCount := 3; // R, G, B.
    3: vComponentCount := 1; // palette index.
    4: vComponentCount := 2; // grayscale, alpha.
    6: vComponentCount := 4; // R, G, B, A.
    else
      raise EFormatError.Create(Format('PNG ColorType %d unknown.', [ColorType]));
    end;
    Result := BitDepth * vComponentCount;
  end;
end;

constructor TLoader.Create(aStream : TStream);
begin
  fRun := TRun.Create();
  fStream := aStream;
  fPixmapInfoR := TPixmapInfo.Create();
  fPixmapInfo := fPixmapInfoR; // pin it down until it's not needed anymore.
  fPreviousRow := @fRow1;
  fCurrentRow := @fRow2;
end;

procedure TLoader.ClearRow(); inline;
var
  vTempRow : TScanlineP;
begin
  vTempRow := fPreviousRow;
  fPreviousRow := fCurrentRow;
  fCurrentRow := vTempRow;
end;

  function abs(a : Integer) : Cardinal; inline;
  begin
    if a < 0 then
      Result := -a
    else
      Result := a
  end;

function PaethPredictor(a, b, c : TByte) : Cardinal; inline;
var
  p : Integer;
  pa : Cardinal;
  pb : Cardinal;
  pc : Cardinal;
  
begin
  p := a + b - c;
  pa := abs(p - a);
  pb := abs(p - b);
  pc := abs(p - c);
  // return nearest of a,b,c, breaking ties in order a,b,c.
  if (pa <= pb) and (pa <= pc) then
    Result := a
  else if (pb <= pc) then 
    Result := b
  else
    Result := c;
end;


procedure UnfilterRow(aFilterType : TByte; var aCurrentRow : TScanlineP; aPreviousRow : TScanlineP; aPixelSizeBytes : TByte {in bytes });
var
  x : TUINT32;
  
    function PreviousA(aArray : TScanlineP) : TByte; inline; // standardized that way for PNG, don't ask me why.
    begin
      if x >= aPixelSizeBytes then
        Result := aArray^[x - aPixelSizeBytes]
      else
        Result := 0;
    end;
    
begin
  if Length(aCurrentRow^) > 0 then
  case aFilterType of
  0: // ftNone: 
    begin
      for x := 0 to High(aCurrentRow^) do
        aCurrentRow^[x] := aCurrentRow^[x];
    end;
  1: // ftSub:
    begin
      for x := 0 to High(aCurrentRow^) do
        aCurrentRow^[x] := (aCurrentRow^[x] + PreviousA(aCurrentRow)) and $FF;
    end;
  2: // ftUp:
    begin
      for x := 0 to High(aCurrentRow^) do
        aCurrentRow^[x] := (aCurrentRow^[x] + aPreviousRow^[x]) and $FF;
    end;
  3: // ftAverage:
    begin
      for x := 0 to High(aCurrentRow^) do
        aCurrentRow^[x] := (aCurrentRow^[x] + ((PreviousA(aCurrentRow) + aPreviousRow^[x]) shr 1)) and $FF;
    end;
  4: // Paeth:
    begin
      for x := 0 to High(aCurrentRow^) do
        aCurrentRow^[x] := (aCurrentRow^[x] + PaethPredictor(PreviousA(aCurrentRow), aPreviousRow^[x], PreviousA(aPreviousRow))) and $FF;
    end;
  end;
{
1 	Sub 	Recon(x) = Filt(x) + Recon(a)
2 	Up 	Recon(x) = Filt(x) + Recon(b)
3 	Average 	Recon(x) = Filt(x) + floor((Recon(a) + Recon(b)) / 2)
4 	Paeth 	Recon(x) = Filt(x) + PaethPredictor(Recon(a), Recon(b), Recon(c))
x 	the byte being filtered;
a 	the byte corresponding to x in the pixel immediately before the pixel containing x (or the byte immediately before x, when the bit depth is less than 8);
b 	the byte corresponding to x in the previous scanline;
c 	the byte corresponding to b in the pixel immediately before the pixel containing b (or the byte immediately before b, when the bit depth is less than 8).
}
end;


function TLoader.NextRun() : TRun;
var
  vFilterType : TByte;
begin
  // if not Assigned(fImageDataStream) ... too slow.
  
  vFilterType := fImageDataStream.ReadByte();
  fImageDataStream.ReadBuffer(fCurrentRow^[0], Length(fCurrentRow^));
  UnfilterRow(vFilterType, fCurrentRow, fPreviousRow, fPixelSizeBytes);
  Result := fRun;
  
  with fIHDRChunk do begin
    case ColorType of
    0: fRun.LoadGrayscale(@fCurrentRow^[0], fPixelSizeBytes, BitDepth);
    2: fRun.LoadRGB(@fCurrentRow^[0], fPixelSizeBytes, BitDepth, BitDepth, BitDepth);
    3: fRun.LoadPalette(@fCurrentRow^[0], fPixelSizeBytes, fPixmapInfoR.Palette, BitDepth);
    4: fRun.LoadGrayscaleAlpha(@fCurrentRow^[0], fPixelSizeBytes, BitDepth, BitDepth);
    6: fRun.LoadRGBA(@fCurrentRow^[0], fPixelSizeBytes, BitDepth, BitDepth, BitDepth, BitDepth);
    else
      raise EFormatError.Create(Format('PNG ColorType %d unknown.', [ColorType]));
    end;
  end;

  ClearRow();

  Result := fRun;
  // FIXME end-of-image nil.
end;

function TLoader.GetHeaders() : IPixmapInfo;
begin
  if not fBHeadersLoaded then
    LoadHeaders();

  Result := fPixmapInfo;
end;

procedure EnsureHeaderValid(const aHeader : THeader); inline;
begin
  with aHeader do 
    if (Magic[0] <> $89) 
    or (Magic[1] <> $50)
    or (Magic[2] <> $4E)
    or (Magic[3] <> $47)
    or (Magic[4] <> $0D)
    or (Magic[5] <> $0A)
    or (Magic[6] <> $1A) 
    or (Magic[7] <> $0A) then
      raise EFormatError.Create('invalid PNG file: invalid main header.');
end;

function LoadPLTEChunkBody(aStream : TStream; vChunkSize : TUINT32) : TIColorArray;
var
  vPaletteChunk : TPLTEChunk;
  vCount : TUINT32;
  vPaletteIndex : Integer;
begin
  assert((vChunkSize mod 3) = 0);
  vCount := vChunkSize div 3;
  FillChar(vPaletteChunk.Palette[0], SizeOf(vPaletteChunk.Palette), 0);
  aStream.ReadBuffer(vPaletteChunk.Palette[0], SizeOf(vPaletteChunk.Palette[0]) * vCount);

  SetLength(Result, vCount);
  if vCount > 0 then
    for vPaletteIndex := 0 to vCount - 1 do
      with vPaletteChunk.Palette[vPaletteIndex] do
        Result[vPaletteIndex] := TRGBColor.Create(Red, Green, Blue);
end;

procedure TLoader.EnsureIHDRLoaded(); inline;
begin
  if fIHDRChunk.BitDepth = 0 then
    raise EFormatError.Create('PNG: ''IHDR'' not loaded yet, but already used.');
end;

function LoadIHDRChunk(aStream : TStream; aDataSize : TUINT32) : TIHDRChunk; inline;
begin
  if aDataSize <> SizeOf(Result) then
    raise EFormatError.Create('PNG: ''IHDR'' chunk has unknown (wrong) size.');
    
  aStream.ReadBuffer(Result, SizeOf(Result));
end;

// slow as molasses.
function LoadASCIIZ(aStream : TStream) : ANSIString;
var
  vItem : TByte;
begin
  SetLength(Result, 0);
  repeat
    vItem := aStream.ReadByte();
    if vItem = 0 then
      Break;
      
    SetLength(Result, Length(Result) + 1);
    Result[Length(Result) - 1] := Chr(vItem);
  until vItem = 0;
end;

type
  TTextR = record
    Keyword : ANSIString;
    Value : ANSIString;
    
    // optional:
    
    Language : ANSIString;
    TranslatedKeyword : ANSIString;
  end;
  
function Load_tEX_t(fStream : TStream; aChunkSize : TUINT32) : TTextR;
var
  vKeyword : ANSIString;
  vValue : ANSIString;
begin
  Result.Language := '';
  Result.TranslatedKeyword := '';
  vKeyword := LoadASCIIZ(fStream); // actually limited to 79 characters.
  if aChunkSize < Length(vKeyword) then
    raise EFormatError.Create('text block: expected keyword, but chunk size is smaller than text would be.');
  Dec(aChunkSize, Length(vKeyword) + 1);
  SetLength(vValue, aChunkSize);
  fStream.ReadBuffer(vValue[1], aChunkSize);
  Result.Keyword := vKeyword;
  Result.Value := vValue;
end;

// TODO just use a windowed stream?

function DecompressString(const aText : ANSIString) : ANSIString; inline;
var
  vDestinationIndex : Integer;
  vMemoryStream : TMemoryStream;
  vDecompressionStream : zstream.TDecompressionStream;
  vReadCount : Integer;
  vBlock : array[0..255] of Char;
begin
    Result := '';
    vDestinationIndex := 1;
    vMemoryStream := TMemoryStream.Create();
    vMemoryStream.WriteBuffer(aText, Sizeof(aText));
    vMemoryStream.Position := 0;
    try
      vDecompressionStream := zstream.TDecompressionStream.Create(vMemoryStream);
      try
        repeat
          vReadCount := vDecompressionStream.Read(vBlock[0], SizeOf(vBlock));
          if vReadCount = 0 then
            Break;
            
          SetLength(Result, Length(Result) + vReadCount);
          Move(vBlock[0], Result[vDestinationIndex], vReadCount);
          Inc(vDestinationIndex, vReadCount);
        until vReadCount = 0;
      finally
        FreeAndNIl(vDecompressionStream);
      end;
    finally
      FreeAndNil(vMemoryStream);
    end;
end;

function Load_zTX_t(fStream : TStream; aChunkSize : TUINT32) : TTextR;
var
  vKeyword : ANSIString;
  vCompressionMethod : TByte;
  vText : ANSIString;
begin
  Result.Language := '';
  Result.TranslatedKeyword := '';
  vKeyword := LoadASCIIZ(fStream); // actually limited to 79 characters.
  if aChunkSize < Length(vKeyword) then
    raise EFormatError.Create('text block: expected keyword, but chunk size is smaller than text would be.');
  Dec(aChunkSize, Length(vKeyword) + 1);

  vCompressionMethod := fStream.ReadByte();
  if vCompressionMethod <> 0 then
    raise EFormatError.Create('text block compression is unknown.');

  if aChunkSize < 1 then
    raise EFormatError.Create('text block size too small.');
    
  Dec(aChunkSize, 1);

  SetLength(vText, aChunkSize);
  fStream.ReadBuffer(vText[1], aChunkSize);

  Result.Value := DecompressString(vText);
end;

function Load_iTX_t(fStream : TStream; aChunkSize : TUINT32) : TTextR;
var
  vKeyword : ANSIString;
  vCompressionFlag : TByte;
  vCompressionMethod : TByte;
  vLanguage : ANSIString;
  vTranslatedKeyword : ANSIString;
  vText : ANSIString;
begin
  vKeyword := LoadASCIIZ(fStream); // actually limited to 79 characters.
  if aChunkSize < Length(vKeyword) then
    raise EFormatError.Create('text block: expected keyword, but chunk size is smaller than text would be.');
  Dec(aChunkSize, Length(vKeyword) + 1);
  
  Result.Keyword := vKeyword;

  vCompressionFlag := fStream.ReadByte();
  if vCompressionFlag > 1 then
    raise EFormatError.Create('text block compression is unknown.');
    
  vCompressionMethod := fStream.ReadByte();
  if vCompressionMethod <> 0 then
    raise EFormatError.Create('text block compression is unknown.');

  if aChunkSize < 2 then
    raise EFormatError.Create('text block size too small.');
    
  Dec(aChunkSize, 2);
  
  vLanguage := LoadASCIIZ(fStream);
  if aChunkSize < Length(vLanguage) then
    raise EFormatError.Create('text block: expected language, but chunk size is smaller than text would be.');
  Dec(aChunkSize, Length(vLanguage) + 1);
  
  Result.Language := vLanguage;

  vTranslatedKeyword := LoadASCIIZ(fStream);
  if aChunkSize < Length(vTranslatedKeyword) then
    raise EFormatError.Create('text block: expected keyword, but chunk size is smaller than text would be.');
  Dec(aChunkSize, Length(vTranslatedKeyword) + 1);

  Result.TranslatedKeyword := vTranslatedKeyword;
    
  SetLength(vText, aChunkSize);
  fStream.ReadBuffer(vText[1], aChunkSize);

  if vCompressionFlag <> 0 then begin
    Result.Value := DecompressString(vText);
  end else
    Result.Value := vText; // FIXME decompress if needed.
end;

const
  cIHDR = $49484452; // TFOURCC = FOURCCFromStr('IHDR');
  cIEND = $49454E44; //: TFOURCC = FOURCCFromStr('IEND');
  cPLTE = $504C5445; // : TFOURCC = FOURCCFromStr('PLTE');
  cIDAT = $49444154; // : TFOURCC = FOURCCFromStr('IDAT');
  c_iTX_t = $69545874; // 'iTXt'.
  c_tEX_t = $74455874; // 'tEXt'.
  c_zTX_t = $7A545874; // 'zTXt'.
  c_bKGD = $624B4744; // 'bKGD'.
  c_tRNS = $74524E53; // 'tRNS'.

// returns the transparent colors as RGBA.
//          Load_tRNSChunk(fStream, vChunkSize, fIHDRChunk.ColorType, fPixmapInfoR.Palette); // can return FEWER colors. Not always associative.
function Load_tRNSChunk(aStream : TStream; aDataSize : TUINT32; aBitDepth : TByte; aColorType : TByte; const aPalette : TIColorArray) : TIColorArray;
var
  vRed : TUINT16;
  vGreen : TUINT16;
  vBlue : TUINT16;
  vIndex : TUINT32;
  vGray : TUINT16;
  vMax : TUINT16;
  
  function Normalize(vValue : TUINT16) : TUINT16; inline;
  begin
    Result := Int64(vValue) * $FFFF div vMax;
  end;
begin
  SetLength(Result, 0);
  vMax := (1 shl aBitDepth) - 1;
  
  case aColorType of
    0:
      begin
        aStream.ReadBuffer(vGray, SizeOf(vGray));
        SetLength(Result, 1);
        Result[0] := TRGBAColor.Create(Normalize(vGray), Normalize(vGray), Normalize(vGray), 0);
      end;
    2:
      begin
        aStream.ReadBuffer(vRed, SizeOf(vRed));
        aStream.ReadBuffer(vGreen, SizeOf(vGreen));
        aStream.ReadBuffer(vBlue, SizeOf(vBlue));
        SetLength(Result, 1);
        Result[0] := TRGBAColor.Create(Normalize(vRed), Normalize(vGreen), Normalize(vBlue), 0);
      end;
    3:
      begin
        SetLength(Result, aDataSize);
        if aDataSize > 0 then
          for vIndex := 0 to aDataSize - 1 do
            with IRGBColor(aPalette[vIndex]) do
              Result[vIndex] := TRGBAColor.Create(Red, Green, Blue, aStream.ReadByte());
      end;
    else
        raise EFormatError.Create(Format('''tRNS'': alpha transparency channel not available for color type %d', [aColorType]));
  end;
end;

function Load_bKGD(aStream : TStream; aDataSize : TUINT32; aBitDepth : TByte; aColorType : TByte; const aPalette : TIColorArray) : IRGBColor;
var
  vPaletteIndex : TByte;
  vGray : TUINT16; // 0..(2^bitdepth)-1
  vRed : TUINT16;
  vGreen : TUINT16;
  vBlue : TUINT16;
  vMax : TUINT16;
  
  function Normalize(vValue : TUINT16) : TUINT16; inline;
  begin
    Result := Int64(vValue) * $FFFF div vMax;
  end;
begin
  vMax := (1 shl aBitDepth) - 1;
  case aColorType of
    3:  // indexed.
      begin
        if aDataSize <> 1 then
          raise EFormatError.Create('PNG: invalid background chunk size.');
        vPaletteIndex := aStream.ReadByte();
        Result := IRGBColor(aPalette[vPaletteIndex]);
      end;
    0, 4: // grayscale, with or without alpha.
      begin
        if aDataSize <> 2 then
          raise EFormatError.Create('PNG: invalid background chunk size.');
        vMax := (1 shl aBitDepth) - 1;
        aStream.ReadBuffer(vGray, SizeOf(vGray));
        Result := TRGBColor.Create(Normalize(vGray), Normalize(vGray), Normalize(vGray));
      end;
    2, 6: // truecolor, with or without alpha.
      begin
        if aDataSize <> 6 then
          raise EFormatError.Create('PNG: invalid background chunk size.');
        aStream.ReadBuffer(vRed, SizeOf(vRed));
        aStream.ReadBuffer(vGreen, SizeOf(vGreen));
        aStream.ReadBuffer(vBlue, SizeOf(vBlue));
        Result := TRGBColor.Create(Normalize(vRed), Normalize(vGreen), Normalize(vBlue));
      end;
    else
      raise EFormatError.Create('PNG: invalid background chunk color type.');
  end;
end;

function CollectIDATChunks(aSource : TStream; aDataSize : TUINT16; const aIHDRChunk : TIHDRChunk; out aNextChunk : TChunkHeader) : TMemoryStream;
var
  vWindow : TStream;
  vPosition : Int64;
begin
  Result := TMemoryStream.Create();

  try
    repeat
      vPosition := aSource.Position;
      vWindow := windowed_streams.TWindowedStream.Create(aSource, aDataSize);
      try
        //vWindow.SourceOwner := False;
        CopyFrom(vWindow, Result);
      finally
        FreeAndNil(vWindow);
      end;
    
      // next.
      aSource.Position := vPosition; // just to be safe.
      aSource.ReadBuffer(aNextChunk, SizeOf(aNextChunk));
      aDataSize := aNextChunk.DataSize;
    until aNextChunk.ChunkType <> cIHDR;
  finally
    FreeAndNil(Result);
  end;
end;


function PrepareIDAT(aSource : TStream; aDataSize : TUINT16; const aIHDRChunk : TIHDRChunk; out aNextChunk : TChunkHeader) : TStream;
var
  vZLIBCompressionFlags : TByte;
  vMoreFlags : TByte;
  vCompressedData : TStream;
  vReader : TStream;
  vZLIBCheckSum : TUINT32;
  vResult : TOwnerStream;
begin
  // zlib format:

  // For PNG compression method 0:
  //    the zlib compression method/flags code must specify method code 8 ("deflate" compression) and an LZ77 window size of not more than 32768 bytes.
  //    Note that the zlib compression method number is not the same as the PNG compression method number. 
  //    The additional flags must not specify a preset dictionary. 
  //    A PNG decoder must be able to decompress any valid zlib datastream that satisfies these additional constraints. 

  if aIHDRChunk.CompressionMethod <> 0 then
    raise EFormatError.Create(Format('unknown PNG compression method: %d. The file is probably broken.', [aIHDRChunk.CompressionMethod]));

  vZLIBCompressionFlags := aSource.ReadByte(); // method + flags.
  vMoreFlags := aSource.ReadByte();
  if vZLIBCompressionFlags <> 8 then
    raise EFormatError.Create(Format('unknown ZLIB compression method: %d. The file is probably broken.', [vZLIBCompressionFlags]));

  // "There may be multiple IDAT chunks; if so, they shall appear consecutively with no other intervening chunks. The compressed datastream is then the concatenation of the contents of the data fields of all the IDAT chunks."
  // While I HAVE a stream class representing a single window into a source stream, I don't have one that's successively adding chunks as it goes... how weird is that?

  // TODO remove memory hog.
  vCompressedData := CollectIDATChunks(aSource, aDataSize, aIHDRChunk, aNextChunk);
  aSource.ReadBuffer(vZLIBCheckSum, Sizeof(vZLIBCheckSum));

  // TODO maybe use DecompressString() instead?
  
  try 
    vResult := zstream.Tdecompressionstream.Create(vCompressedData, True { skip header });
  except
    FreeAndNil(vCompressedData);
    raise;
  end;
  Result := vResult;
  try
    vResult.SourceOwner := True;
  except
    FreeAndNil(vResult);
    raise;
  end;
end;

destructor TLoader.Destroy();
begin
  FreeAndNil(fImageDataStream);
  FreeAndNil(fRun);
  inherited Destroy();
end;
      
procedure TLoader.LoadHeaders();
var
  vHeader : THeader;
  vChunkHeader : TChunkHeader;
  vChunkType : TFOURCC;
  vChunkSize : TUINT32;
  vScanlineSize : TUINT32;
begin
  if fBHeadersLoaded then 
    Exit;
    
  fStream.ReadBuffer(vHeader, SizeOf(vHeader));
  EnsureHeaderValid(vHeader);

  repeat
    fStream.ReadBuffer(vChunkHeader, SizeOf(vChunkHeader));
    
    repeat
      vChunkSize := vChunkHeader.DataSize;
      vChunkType := vChunkHeader.ChunkType;
      vChunkHeader.ChunkType := cIEND;
      
      case vChunkType of
      cIEND:
        Break;
      cIHDR:
        begin
          if fIHDRChunk.BitDepth > 0 then
            raise EFormatError.Create('PNG image contained more than 1 ''IHDR'' chunk.');
            
          fIHDRChunk := LoadIHDRChunk(fStream, vChunkSize);
          if fIHDRChunk.FilterMethod <> 0 then
            raise EFormatError.Create(Format('PNG filter method %d is unknown.', [fIHDRChunk.FilterMethod]));
            
          fPixelSizeBits := PixelSize(fIHDRChunk);
          fPixelSizeBytes := (fPixelSizeBits + 7) shr 3;

          // PNG specification says these are supposed to be 0 outside.
          vScanlineSize := (fIHDRChunk.Width * fPixelSizeBits + 7) shr 3; // bytes.
          SetLength(fRow1, vScanlineSize);
          FillChar(fRow1, vScanlineSize, 0);
          SetLength(fRow2, vScanlineSize);
          FillChar(fRow2, vScanlineSize, 0);
        end;
      cPLTE:
        begin
          EnsureIHDRLoaded();
          
          if Assigned(fPixmapInfoR.Palette) then
            raise EFormatError.Create('PNG image contained more than 1 palette.');
          
          if not (fIHDRChunk.ColorType in [3, 2, 6]) then
            raise EFormatError.Create('PNG image contains a palette for a colorspace where none is needed.');
            
          if (vChunkSize mod 3) <> 0 then
            raise EFormatError.Create('PNG: palette chunk size not divisible by 3 without remainder.');

           fPixmapInfoR.Palette := LoadPLTEChunkBody(fStream, vChunkSize);
        end;
      cIDAT:
        begin
          // can have multiple, but then they must be consecutive.
          EnsureIHDRLoaded();
          if Assigned(fImageDataStream) then
            raise EFormatError.Create('PNG: more than one image data block not supported.');
            
          fImageDataStream := PrepareIDAT(fStream, vChunkSize, fIHDRChunk, {out} vChunkHeader);
        end;
      c_iTX_t:
        begin
          Load_iTX_t(fStream, vChunkSize);
        end;
      c_tEX_t:
        begin
          Load_tEX_t(fStream, vChunkSize);
        end;
      c_zTX_t:
        begin
          Load_zTX_t(fStream, vChunkSize);
        end;
      c_bKGD:
        begin
          // after PLTE.
          EnsureIHDRLoaded();
          Load_bKGD(fStream, vChunkSize, fIHDRChunk.BitDepth, fIHDRChunk.ColorType, fPixmapInfoR.Palette);
        end;
      c_tRNS:
        begin
          EnsureIHDRLoaded();
          // if any, EnsurePLTELoaded();
          Load_tRNSChunk(fStream, vChunkSize, fIHDRChunk.BitDepth, fIHDRChunk.ColorType, fPixmapInfoR.Palette); // can return FEWER colors. Not always associated.
        end;
      else
        begin
          warn('ignoring chunk...');
          SkipJunk(fStream, vChunkSize);
        end;
      end;
    until vChunkHeader.ChunkType = cIEND; // sometimes, functions like LoadIHDR will read too much and set vChunkHeader themselves. In that case, handle it as normal data.

  {
  4.2.2.1. gAMA Image gamma
  4.2.2.2. cHRM Primary chromaticities
  4.2.2.3. sRGB Standard RGB color space
  4.2.2.4. iCCP Embedded ICC profile
  }
  // 4.2.4.6. tIME Image last-modification time
  until vChunkType = cIEND;
end;

{
   Critical chunks (must appear in this order, except PLTE is optional):
   
           Name  Multiple  Ordering constraints
                   OK?
   
           IHDR    No      Must be first
           PLTE    No      Before IDAT
           IDAT    Yes     Multiple IDATs must be consecutive
           IEND    No      Must be last
}

{$ASSERTIONS ON}

initialization
  assert(SizeOf(TIHDRChunk) = 13);
  assert(SizeOf(TPaletteEntry) = 3);

end.