agpl_1.0.0_b5da3320/3rdparty/png_io/png_io.adb

---------------------------------------------------------------------
---------------------------------------------------------------------
-- PNG_IO -- Ada95 Portable Network Graphics Input/Output Package  --
--                                                                 --
-- Copyright (©) 1999 Dr Stephen J. Sangwine (S.Sangwine@IEEE.org) --
--                                                                 --
-- This software was created by Stephen J. Sangwine. He hereby     --
-- asserts his Moral Right to be identified as author of this      --
-- software.                                                       --
---------------------------------------------------------------------
---------------------------------------------------------------------
-- PNG_IO is free software; you can redistribute it and/or modify  --
-- it under the terms of the GNU General Public License as         --
-- published by the Free Software Foundation; either version 2 of  --
-- the License, or (at your option) any later version.             --
--                                                                 --
-- PNG_IO is distributed in the hope that it will be useful, but   --
-- WITHOUT ANY WARRANTY; without even the implied warranty of      --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the    --
-- GNU General Public License for more details.                    --
--                                                                 --
-- You should have received a copy of the GNU General Public       --
-- License along with this software (in the file gpl.txt); if not, --
-- contact the Free Software Foundation, or access www.fsf.org.    --
---------------------------------------------------------------------
---------------------------------------------------------------------
-- Date: 26    August 1999                                         --
-- Edit:  9 September 1999 to insert check on size of uncompressed --
--                         data in PNG_IO.Open => Version ".1"     --
--       14 December  1999 to modify version to ".1a" reflecting   --
--                         minor change in png_io-open.adb         --
--       29 February  2000 to use generic Zlib package, hence 1.2. --
--       12     July  2000 to change the buffer size calculation   --
--                         in procedure Write_IDAT_Chunk to use a  --
--                         more robust calculation added to the    --
--                         generic_zlib package. This corrects a   --
--                         buffer overflow for images of more than --
--                         4,290,676 bytes and should now work for --
--                         images up to almost 4GB.                --
--       13      July 2000 to make the Write_IDAT_Chunk procedure  --
--                         use heap-allocated buffers rather than  --
--                         stack variables, and deallocate the     --
--                         uncompressed data buffer as soon as the --
--                         compressed data has been generated.     --
--       17      July 2000 to change with clause from              --
--                         Sequential_IO to Direct_IO, to enable   --
--                         changes in png_io-open.adb. Fixed error --
--                         with Type 4 handling in Alpha_Value.    --
--                         Released as version 1.3.                --
--        1  November 2000 to add the sRGB chunk code and support  --
--                         for reading the raw data from ancillary --
--                         chunks that are not directly supported. --
--       20  November 2000 to finish code for writing text chunks. --
--        9     March 2001 to add extra sRGB functions.            --
--       15       May 2002 to add function Sample_Depth, and to    --
--                         detect unopen file passed to Close and  --
--                         raise exception.                        --
--       24       May 2002 to add code to Adam7 to support output. --
--        2      June 2003 to fix the Write_PNG_Type_3 parameters  --
--                         (P was missing from the body stub);     --
--                         to change the two variables Temp in     --
--                         Close procedure to constants;           -- 
--                         to remove redundant type conversions in --
--                         the function Sub_Image_Size.            --
--        9   January 2004 commented out Chunk_Ordering.After_PLTE,--
--                         moved the full declaration of Text_Item --
--                         ahead of that of PNG_File_Descriptor,   --
--                         deleted Inline pragma for Interlaced.   --
--       10   January 2004 to add the function Zlib_Version.       --
--       29      June 2004 to fix the Palette function to return   --
--                         True if a palette was found in the file --
--                         rather than just the file was a type 3. --
--        1      July 2004 to replace the temporary binding to     --
--                         Zlib with Zlib_Ada, and use Stream_IO.  --
--       10 September 2004 to change version to 4.2, for use with  --
--                         Zlib_Ada release 1.3.                   --
--       25 November  2004 version 4.2.1.                          --
--        1 December  2004 added third "&" function for chunks to  --
--                         return a Chunk_List from two Chunks and --
--                         changed version to 4.2.2. Fixed bug in  --
--                         function Standard_RGB_Chunk.            --
--         3    March 2005 added fourth "&" function to join two   --
--                         Chunk_Lists.                            --
--        12   August 2006 changed the handling of the version and --
--                         the Package_Identifier to make PNG_IO   --
--                         compliant with the Ravenscar profile.   --
--        13   August 2006 references to the PNG Specification 1.2 --
--                         amended to refer to the ISO standard.   --
--                         Moved renaming of Zlib_Version to spec. --
--     9/10 September 2006 changes due to modifications to Write   --
--                         procedures to avoid buffering of IDAT   --
--                         data, using on-the-fly compression.     --
---------------------------------------------------------------------
---------------------------------------------------------------------

with Ada.Exceptions;
use  Ada.Exceptions;

with Ada.Streams.Stream_IO;
use  Ada.Streams.Stream_IO;

with Ada.Unchecked_Deallocation,
     Ada.Characters.Latin_1,
     Ada.Characters.Handling;

with Interfaces;
use  Interfaces;

with PNG_IO.Chromaticity_Data;

with PNG_IO.Adam7;
use  PNG_IO.Adam7;

package body PNG_IO is

  -- 12 August 2006 : the way the version number is declared was changed in order
  -- to make PNG_IO comply with the Ravenscar profile (at least under Gnat/gcc -
  -- since there are some implementation dependencies in this profile). Thanks
  -- to Samuel Tardieu for pointing out that PNG_IO was almost Ravenscar compliant
  -- and that only a small change would be needed to make it so.

  Version_String : constant String := "4.4";

  function Version return String is begin return Version_String; end;

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

  function Valid_Zlib_Header(CMG, FLG : in Stream_Element) return Boolean is
    -- This function checks the data in the first two bytes of a Zlib
    -- data stream, supplied as the two parameters. (ISO standard, section 10.1.)
    -- We check the least significant 4 bits of CMG (the first byte)
    -- and that the overall 16-bit value is a multiple of 31 as required
    -- by RFC1950 (the Zlib Compressed Data Format Specification).
  begin
    return (CMG and 2#1111#) = 8
       and (Unsigned_16(CMG) * 256 + Unsigned_16(FLG)) mod 31 = 0;
  end Valid_Zlib_Header;

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

  -- All PNG files have the same initial 8 bytes (the signature):

  PNG_Signature : constant Stream_Element_Array := (16#89#, 16#50#, 16#4E#, 16#47#,
                                                    16#0D#, 16#0A#, 16#1A#, 16#0A#);

  ----------------------------------------------------------------------
  -- PNG files written by this package contain the following text in a
  -- tEXt chunk to indicate the software that wrote the chunk.

  Package_Identifier : constant String := "Software"
                                          & Ada.Characters.Latin_1.NUL
                                          & "PNG_IO Version " & Version_String
                                          & " by Steve Sangwine (S.Sangwine@IEEE.org).";

  -------------------------------------------------------------------------
  IDAT_Size : constant := 8 * 2**10; -- This determines the maximum size of
                                     -- IDAT chunk that will be output.
  -------------------------------------------------------------------------

  -- A PNG file can contain various chunks, each with a 4-byte chunk type
  -- code.  The chunk type codes are defined here numerically, so that they
  -- are static, but they are verified at the end of this body in the package
  -- initialisation code so that errors in the coding of the numerical values
  -- are trapped.  If any new codes are added the verification code must also
  -- be added.  PNG type codes are defined in terms of ISO 8859-1 Latin-1
  -- character codes as are the codes for the Ada95 package Standard listed
  -- in LRM Section A.1 from which the following table is derived:

  --      x = 0123456789ABCDEF
  -- 16#4x#    ABCDEFGHIJKLMNO
	-- 16#5x#   PQRSTUVWXYZ 
	-- 16#6x#    abcdefghijklmno
	-- 16#7x#   pqrstuvwxyz

  IHDR : constant := 16#49484452#;
  PLTE : constant := 16#504C5445#;
  IDAT : constant := 16#49444154#;
  IEND : constant := 16#49454E44#;

  tRNS : constant := 16#74524E53#;
  gAMA : constant := 16#67414D41#;
  cHRM : constant := 16#6348524D#;
  sRGB : constant := 16#73524742#;
  iCCP : constant := 16#69434350#;
  tEXt : constant := 16#74455874#;
  zTXt : constant := 16#7A545874#;
  iTXt : constant := 16#69545874#;

  bKGD : constant := 16#624B4744#;
  pHYs : constant := 16#70485973#;
  sBIT : constant := 16#73424954#;
  sPLT : constant := 16#73504C54#;
  hIST : constant := 16#68495354#;
  tIME : constant := 16#74494D45#;

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

  function To_Chunk_Name(C : Unsigned_32) return Chunk_Name is
  begin
    return Character'Val((Shift_Right(C, 24) and 16#FF#)) &
           Character'Val((Shift_Right(C, 16) and 16#FF#)) &
           Character'Val((Shift_Right(C,  8) and 16#FF#)) &
           Character'Val(             C      and 16#FF#);
  end To_Chunk_Name;

  function To_Unsigned_32(N : Chunk_Name) return Unsigned_32 is
    B1 : constant Unsigned_32 := Shift_Left(Character'Pos(N(1)), 24);
    B2 : constant Unsigned_32 := Shift_Left(Character'Pos(N(2)), 16);
    B3 : constant Unsigned_32 := Shift_Left(Character'Pos(N(3)),  8);
    B4 : constant Unsigned_32 :=            Character'Pos(N(4));
  begin
    return B1 or B2 or B3 or B4; 
  end To_Unsigned_32;

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

  package Chunk_Ordering is

    -- An encoding/LUT of the rules laid out in the ISO standard
    -- (Section 5.6 and Table 5.3). This should not be confused with the
    -- three positions available to the user of PNG_IO when writing a
    -- file (before the PLTE, between PLTE and IDAT, and after IDAT).

    function Known_Chunk(C : Unsigned_32) return Boolean;

    function Before_PLTE(C : Unsigned_32) return Boolean;
  --function  After_PLTE(C : Unsigned_32) return Boolean; -- Not currently used.
    function Before_IDAT(C : Unsigned_32) return Boolean;

  end Chunk_Ordering;
  use Chunk_Ordering;

  package body Chunk_Ordering is separate;

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

  function Known_Chunk(Name : Chunk_Name) return Boolean is
  begin
    return Known_Chunk(To_Unsigned_32(Name));
  end Known_Chunk;

  function Position(C : Unsigned_32) return Chunk_Position is
    -- Gives the position in terms of the three choices available
    -- to the user. The choice is a priority encoding of the positions
    -- defined in the PNG specification.
  begin
    if Before_PLTE(C) then
      return Before_PLTE;
    elsif Before_IDAT(C) then
      return Before_IDAT; -- This means after PLTE if it exists.
    else
      return Anywhere;
    end if;
  end Position;

  function Position(Name : Chunk_Name) return Chunk_Position is
    C : constant Unsigned_32 := To_Unsigned_32(Name);
  begin
    if Known_Chunk(C) then
      return Position(C);
    else
      raise Argument_Error;
    end if;
  end Position;

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

  -- We also need to be able to check other chunk types to make
  -- sure they are ancillary (bit 5 of the first byte is set).

  function Ancillary(C : Unsigned_32) return Boolean is
  begin
    return (C and 2#00100000_00000000_00000000_00000000#) /= 0;
  end Ancillary;

  function Safe_to_Copy(C : Unsigned_32) return Boolean is
    -- An internal function which tests bit 5 of the least significant
    -- byte of a chunk type (the safe to copy bit).
  begin
    return (C and 2#00000000_00000000_00000000_00100000#) /= 0;
  end Safe_to_Copy;
  pragma Inline(Safe_to_Copy);

  function Safe_to_Copy(C : Chunk) return Boolean is
    -- The function visible outside the package.
  begin
    return Safe_to_Copy(To_Unsigned_32(C.Name));
  end Safe_to_Copy;

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

  -- Define the PNG filter type codes.

  None    : constant := 0;
  Sub     : constant := 1;
  Up      : constant := 2;
  Average : constant := 3;
  Paeth   : constant := 4;

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

  -- Look up tables for converting bit depths and colour type codes to bytes.

  Bit_Depth_Table   : constant array(Depth)            of Stream_Element := (1, 2, 4, 8, 16);
  Colour_Type_Table : constant array(Colour_Type_Code) of Stream_Element := (0, 2, 3, 4, 6);

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

  type Palette_Data is array(Unsigned_8 range <>) of Unsigned_8;

  type Colour_Palette(Size : Unsigned_8) is
    record
      R, G, B : Palette_Data(0 .. Size);
    end record;

  type Palette_Pointer is access Colour_Palette;

  subtype Buffer is Stream_Element_Array;

  type Buffer_Pointer is access Buffer;

  subtype Buffer_2 is Buffer(1 .. 2); -- I.e. 2 bytes, 16 bits.
  subtype Buffer_4 is Buffer(1 .. 4); -- I.e. 4 bytes, 32 bits.

  function To_Buffer_2(U : Unsigned_16) return Buffer_2 is
  begin
    return Stream_Element(Shift_Right(U and 16#FF00#, 8))
         & Stream_Element(            U and 16#00FF#    );
  end To_Buffer_2;

  function To_Buffer_4(U : Unsigned_32) return Buffer_4 is
    B : Buffer_4;
    L : Unsigned_32 := U;
  begin
    for I in reverse B'Range loop
      B(I) := Stream_Element(L and 16#FF#);
      exit when I = B'First;
      L := Shift_Right(L, 8);
    end loop;
    return B;
  end To_Buffer_4;

  -- The Text_Item type is used to store a keyword/text string pair and a
  -- link pointer. Text strings are stored in a linked list with the
  -- head pointer in the PNG_File_Descriptor. This is awkward, but
  -- since the number of these strings is not defined, and they are
  -- of variable length, it is difficult to see what else to do.

  type String_Pointer is access String;

  type Text_Item;
  type Text_Item_Pointer is access Text_Item;

  type Text_Item is
    record
      Keyword     : String_Pointer;
      Text_String : String_Pointer;
      Link        : Text_Item_Pointer;
    end record;

  type Pass_Offsets is array(Pass_Number) of Stream_Element_Offset;

  type PNG_File_Descriptor is
    record
      Handle      : File_Type;
      Stream      : Stream_Access;
      Width,
      Height      : Dimension;
      Bit_Depth,
      Colour_Type,
      Compression,
      Filter,
      Interlace   : Unsigned_8;

      Gamma            : Boolean := False;
      Gamma_Value      : Unsigned_32;
      Chroma           : Boolean := False;
      White_X, White_Y,
      Red_X,     Red_Y,
      Green_X, Green_Y,
      Blue_X,   Blue_Y  : Unsigned_32;
      SRGB              : Boolean := False;
      Rendering         : Rendering_Intent;
      Physical          : Boolean := False;
      Phys_X, Phys_Y    : Unsigned_32;
      Phys_Unit         : Unsigned_8;
      Number_of_Texts   : Natural := 0;
      Text_Strings      : Text_Item_Pointer;
      Number_of_Chunks  : Natural := 0; -- Unrecognised ancillary chunks
      Ancillary_Chunks  : Chunk_List;   -- are tacked on here as a list.

      Palette           : Palette_Pointer;
      Uncompressed_Data : Buffer_Pointer;
      Interlace_Offsets : Pass_Offsets;
    end record;

  procedure Deallocate is new Ada.Unchecked_Deallocation(Buffer, Buffer_Pointer);

  function To_Stream_Element_Array(S : String) return Stream_Element_Array is
    B : Stream_Element_Array(1 .. S'Length);
    I : Stream_Element_Offset := B'First;
    J : Positive := S'First;
  begin
    loop
      B(I) := Stream_Element(Character'Pos(S(J)));
      exit when J = S'Last;
      I := I + 1; J := J + 1;
    end loop;
    return B;
  end To_Stream_Element_Array;

  To_Stream_Element : constant array(Boolean) of Stream_Element := (0, 1);

  procedure Check(F : in PNG_File) is
    -- Checks that the file descriptor F exists.
  begin
    if F = null then
      Raise_Exception(Call_Error'Identity,
        "Attempt to access non-existent file descriptor.");
    end if;
  end Check;
  pragma Inline(Check);

  function Bits_per_Pixel(Colour_Type : Colour_Type_Code;
                          Bit_Depth   : Depth) return Positive is
    -- The number of bits per pixel in the IDAT chunks. This is not
    -- always the same as the number of bits per pixel in the image.
    -- The only exception is that there are 24 bits per pixel for
    -- images of colour type 3 (palette colour).
    BD : constant Positive := Positive(Bit_Depth_Table(Bit_Depth));
  begin
    case Colour_Type is
      when Zero  => return BD;     -- Greyscale.
      when Two   => return BD * 3; -- RGB
      when Three => return BD;     -- Palette colour.
      when Four  => return BD * 2; -- Greyscale + alpha.
      when Six   => return BD * 4; -- RGB + alpha.
    end case;
  end;
  pragma Inline(Bits_per_Pixel);

  function Bytes_per_Pixel(Colour_Type : Colour_Type_Code;
                           Bit_Depth   : Depth) return Positive is
    -- The number of bytes in each pixel rounded up to 1 for bit depths
    -- less than 8. Used in filtering scanlines where it defines the
    -- offset between one byte and the corresponding byte from the next
    -- pixel, or containing the next pixel.
  begin
    return Positive'Max(1, (Bits_per_Pixel(Colour_Type, Bit_Depth))/8);
  end Bytes_per_Pixel;
  pragma Inline(Bytes_per_Pixel);

  function Bytes_per_Scanline(Colour_Type    : Colour_Type_Code;
                              Bit_Depth      : Depth;
                              Scanline_Width : Dimension) return Stream_Element_Count is
    -- The number of bytes per scanline (excluding the filter type
    -- byte) must allow for pixels of less than 8 bits with image
    -- widths which do not result in an integral number of bytes.
    -- We round up the number of bytes by adding 7 to the number
    -- of bits.
  begin
    return Stream_Element_Count(Bits_per_Pixel(Colour_Type, Bit_Depth) * Scanline_Width + 7)/8;
  end;
  pragma Inline(Bytes_per_Scanline);

  function Image_Size(Colour_Type : Colour_Type_Code;
                      Bit_Depth   : Depth;
                      X, Y        : Dimension;
                      Interlaced  : Boolean) return Stream_Element_Count is

    -- Computes the size of image data in bytes, taking account of
    -- wasted bits, filter type bytes and interlacing, for use in
    -- allocating buffers.

    function Sub_Image_Size(W, H : Natural) return Stream_Element_Count is
    begin
      if W = 0 or H = 0 then
        return 0; -- Empty pass: see PNG Specification Section 2.6.
      else
        -- The + 1 in the next line is to allow for the filter type byte.
        return Stream_Element_Count(H) * (Bytes_per_Scanline(Colour_Type, Bit_Depth, W) + 1);
      end if;
    end Sub_Image_Size;
    pragma Inline(Sub_Image_Size);

  begin
    if not Interlaced then
      return Sub_Image_Size(X, Y);
    else
      declare
        R : Stream_Element_Count := 0;
      begin
        for P in Pass_Number loop
          R := R + Sub_Image_Size(Sub_Image_Width(X, P), Sub_Image_Height(Y, P));
        end loop;
        return R;
      end;
    end if;
  end Image_Size;

  function Interlaced(F : PNG_File) return Boolean is
  begin
    return F.Interlace = 1; -- Simplified 26 May 2002. The byte can only be 0 or 1.
  end Interlaced;

  function Mean(X, Y : Stream_Element) return Stream_Element is
    -- Function to compute the mean value used in the Average
    -- filter described in the ISO standard, Section 9.2 and Table 9.1.
    type Nine_Bit is mod 2**9;
  begin
    return Stream_Element((Nine_Bit(X) + Nine_Bit(Y))/2);
  end;
  pragma Inline(Mean);

  function PaethPredictor(A, B, C : Stream_Element) return Stream_Element is
    -- This code is based on the pseudocode given in the ISO standard, Section 9.4.
    P  : constant Integer := Integer(A) + Integer(B) - Integer(C);
    PA : constant Integer := abs(P - Integer(A));
    PB : constant Integer := abs(P - Integer(B));
    PC : constant Integer := abs(P - Integer(C));
  begin
    if PA <= PB and PA <= PC then return A;
    elsif PB <= PC then return B;
    else return C;
    end if;
  end PaethPredictor;
  pragma Inline(PaethPredictor);

  function Width(F : PNG_File) return Dimension is
  begin
    Check(F); return F.Width;
  end;

  function Height(F : PNG_File) return Dimension is
  begin
    Check(F); return F.Height;
  end;

  function Bit_Depth(F : PNG_File) return Depth is
  begin
    Check(F);
    case F.Bit_Depth is
      when      1 => return One;
      when      2 => return Two;
      when      4 => return Four;
      when      8 => return Eight;
      when     16 => return Sixteen;
      when others => -- Since F.Bit_Depth was validated when the IHDR chunk
                     -- was read by Open, this simply should not happen. So
                     raise Program_Error; 
    end case;
  end;

  function Sample_Depth(F : PNG_File) return Positive is
  begin
    if Colour_Type(F) /= Three then
      return Positive(Bit_Depth_Table(Bit_Depth(F)));
    else        -- The image is a palette image and the number of
      return 8; -- bits per sample is independent of bit depth.
    end if;
  end Sample_Depth;

  function Colour_Type(F : PNG_File) return Colour_Type_Code is
  begin
    Check(F);
    declare
      T : Unsigned_8 renames F.Colour_Type;
    begin
      if    T = 0 then return Zero;
      elsif T = 2 then return Two;
      elsif T = 3 then return Three;
      elsif T = 4 then return Four;
      elsif T = 6 then return Six;
      else  raise Program_Error;
      end if;
    end;
  end;

  function Palette(F : PNG_File) return Boolean is
    -- The test here was modified 29 June 2004. Previously
    -- it checked for a colour type of 3 rather than for the
    -- presence of a palette. (Colour types 2 and 6 can have
    -- an optional palette.)
  begin
    Check(F); return F.Palette /= null;
  end;

  function Palette_Size(F : PNG_File) return Positive is
  begin
    return Positive(Natural(F.Palette.Size) + 1);
  end Palette_Size;

  -- Palette indices run from 0 .. Size - 1;

  function Palette_R_Value(F : PNG_File; Index : Natural) return Natural is
  begin
    if Unsigned_8(Index) <= F.Palette.Size then
      return Natural(F.Palette.R(Unsigned_8(Index)));
    else
      Raise_Exception(Call_Error'Identity, "Palette index out of range.");
    end if;
  end Palette_R_Value;

  function Palette_G_Value(F : PNG_File; Index : Natural) return Natural is
  begin
    if Unsigned_8(Index) <= F.Palette.Size then
      return Natural(F.Palette.G(Unsigned_8(Index)));
    else
      Raise_Exception(Call_Error'Identity, "Palette index out of range.");
    end if;
  end Palette_G_Value;

  function Palette_B_Value(F : PNG_File; Index : Natural) return Natural is
  begin
    if Unsigned_8(Index) <= F.Palette.Size then
      return Natural(F.Palette.B(Unsigned_8(Index)));
    else
      Raise_Exception(Call_Error'Identity, "Palette index out of range.");
    end if;
  end Palette_B_Value;

  procedure Open(F : in out PNG_File; Filename : in String) is separate;

  procedure Close(F : in out PNG_File) is
    -- Called by the user but also in the event of an exception during Open.
    procedure Deallocate is new Ada.Unchecked_Deallocation(Colour_Palette, Palette_Pointer);
    procedure Deallocate is new Ada.Unchecked_Deallocation(Text_Item, Text_Item_Pointer);
    procedure Deallocate is new Ada.Unchecked_Deallocation(PNG_File_Descriptor, PNG_File);
    procedure Deallocate is new Ada.Unchecked_Deallocation(Chunk_List_Element, Chunk_List);
  begin
    if F = null then
      -- The file is not open or has not been opened (it might already have been closed.)
      -- The standard packages such as Ada.Direct_IO raise Status_Error in this situation
      -- so we do the same here. We cannot allow this to go undetected, otherwise we will
      -- get exceptions in the following code when we attempt to access elements of the
      -- record (not) accessed by F.
      Raise_Exception(Status_Error'Identity, "Attempt to close non-open file.");
    end if;
    -- Deallocate has no effect if the access value is null. LRM 13.11.2(8)
    Deallocate(F.Palette);
    Deallocate(F.Uncompressed_Data);
    while F.Ancillary_Chunks /= null loop
      declare
        Temp : constant Chunk_List := F.Ancillary_Chunks.Link;
      begin
        Deallocate(F.Ancillary_Chunks); F.Ancillary_Chunks := Temp;
      end;
    end loop;
    while F.Text_Strings /= null loop
      declare
        Temp : constant Text_Item_Pointer := F.Text_Strings.Link;
      begin
        Deallocate(F.Text_Strings); F.Text_Strings := Temp;
      end;          
    end loop;
    if Is_Open(F.Handle) then Close(F.Handle); end if;
    Deallocate(F);
  end Close;

  function Pixel_Index(F : PNG_File; R, C : Coordinate) return Stream_Element_Offset is
    -- A function to compute the index in the uncompressed data buffer
    -- of the first byte containing the pixel at position R, C. Note
    -- that the pixel itself may occupy more or less than a whole byte.
  begin
    Check(F); -- Make sure F exists.
    if R + 1 > F.Height or C + 1 > F.Width then
      Raise_Exception(Constraint_Error'Identity, "Coordinate(s) out of range.");
    end if;
    declare
      function Index(R, C : Coordinate; W : Dimension) return Stream_Element_Offset is
        -- Computes the index of the desired byte within the image or sub-image.
        CT  : constant Colour_Type_Code := Colour_Type(F);
        BD  : constant            Depth := Bit_Depth(F);
        Bpp : constant         Positive := Bits_per_Pixel(CT, BD);
      begin
        return 1 +  Stream_Element_Offset(R) * Stream_Element_Offset(Bytes_per_Scanline(CT, BD, W) + 1)
             + 1 + (Stream_Element_Offset(C) * Stream_Element_Offset(Bpp))/8;
      end Index;
      pragma Inline(Index);

      W : constant Dimension := Width(F);
    begin
      if not Interlaced(F) then
        return Index(R, C, W);
      else
        declare
          P : constant Pass_Number := Pass(R, C);
        begin
          return F.Interlace_Offsets(P) - 1
               + Index(Sub_Image_Row(R, C), Sub_Image_Col(R, C), Sub_Image_Width(W, P));
        end;
      end if;
    end;
  end Pixel_Index;
  pragma Inline(Pixel_Index);

  -- Low-level functions to fetch the byte/word at a given coordinate in the image.
  -- The offset allows for colour and alpha bytes/words to be fetched.

  function U8(F : PNG_File; R, C : Coordinate; Offset : Stream_Element_Offset := 0) return Unsigned_8 is
  begin
    return Unsigned_8(F.Uncompressed_Data(Pixel_Index(F, R, C) + Offset));
  end U8;
  pragma Inline(U8);

  function U16(F : PNG_File; R, C : Coordinate; Offset : Stream_Element_Offset := 0) return Unsigned_16 is
    P : constant Stream_Element_Offset := Pixel_Index(F, R, C) + Offset;
    D : Stream_Element_Array renames F.Uncompressed_Data.all;
  begin
    return Shift_Left(Unsigned_16(D(P)), 8) or Unsigned_16(D(P + 1));
  end U16;
  pragma Inline(U16);

  -- Low-level function to fetch bits, half nibbles or nibbles at a given coordinate
  -- in the image. Since the leftmost pixels are in the high order bits of the byte
  -- ISO standard, Section 7.2), we have to reverse the position by subtraction from 7/3/1.
  -- Modified 18 July 2000 to change BD from Depth_1_2_4 to Unsigned_8 for efficiency.

  function U1_2_4(F    : PNG_File;
                  R, C : Coordinate;
                  BD   : Unsigned_8) return Unsigned_8 is
    B : constant Unsigned_8 := U8(F, R, C); -- The byte containing the pixel.
    T : constant array(Boolean) of Coordinate := (False => C,
                                                  True  => Sub_Image_Col(R, C));
    K : constant Coordinate := T(Interlaced(F));
  begin
    case BD is
      when 1 => return Shift_Right(B,      7 - (K rem 8))  and 2#0000_0001#;
      when 2 => return Shift_Right(B, 2 * (3 - (K rem 4))) and 2#0000_0011#;
      when 4 => return Shift_Right(B, 4 * (1 - (K rem 2))) and 2#0000_1111#;
      when others => raise Program_Error;
    end case;
  end U1_2_4;
  pragma Inline(U1_2_4);

  -- Because the following functions will be called a very large number of
  -- times there is limited error checking of the values in order not to
  -- slow down image reading. These functions were modified 18 July 2000 to
  -- remove calls to Bit_Depth and replace these with F.Bit_Depth because
  -- this is more efficient.

  function Palette_Index(F : PNG_File; R, C : Coordinate) return Unsigned_8 is
    function Validate(I : Unsigned_8) return Unsigned_8 is
    begin
      if I > F.Palette.Size then
        Raise_Exception(Format_Error'Identity, "Invalid pixel data in palette image.");
      else
        return I;
      end if;      
    end Validate;
    pragma Inline(Validate);
  begin
    case F.Bit_Depth is
      when 1 | 2 | 4  => return Validate(U1_2_4(F, R, C, F.Bit_Depth));
      when 8          => return Validate(    U8(F, R, C));
      when others     => raise  Program_Error; -- Since the PLTE chunk was checked on
    end case;                                  -- reading this shouldn't happen.
  end Palette_Index;
  pragma Inline(Palette_Index);

  function Pixel_Value(F : PNG_File; R, C : Coordinate) return Natural is
  begin
    if F.Colour_Type = 3 then
      return Natural(Palette_Index(F, R, C));
    else
      case F.Bit_Depth is
        when  1 | 2 | 4 => return Natural(U1_2_4(F, R, C, F.Bit_Depth));
        when  8         => return Natural(    U8(F, R, C));
        when 16         => return Natural(   U16(F, R, C));
        when others     => raise  Program_Error; -- This shouldn't happen.
      end case;
    end if;
  end Pixel_Value;

  function Red_Value(F : PNG_File; R, C : Coordinate) return Natural is
  begin
    if F.Colour_Type = 3 then
      return Natural(F.Palette.R(Palette_Index(F, R, C)));
    else
      case F.Bit_Depth is
        when  8     => return Natural(U8 (F, R, C));
        when 16     => return Natural(U16(F, R, C));
        when others => raise  Call_Error;
      end case;
    end if;
  end Red_Value;

  function Green_Value(F : PNG_File; R, C : Coordinate) return Natural is
  begin
    if F.Colour_Type = 3 then
      return Natural(F.Palette.G(Palette_Index(F, R, C)));
    else
      case F.Bit_Depth is
        when  8     => return Natural(U8 (F, R, C, 1));
        when 16     => return Natural(U16(F, R, C, 2));
        when others => raise  Call_Error;
      end case;
    end if;
  end Green_Value;

  function Blue_Value(F : PNG_File; R, C : Coordinate) return Natural is
  begin
    if F.Colour_Type = 3 then
      return Natural(F.Palette.B(Palette_Index(F, R, C)));
    else
      case F.Bit_Depth is
        when  8     => return Natural(U8 (F, R, C, 2));
        when 16     => return Natural(U16(F, R, C, 4));
        when others => raise  Call_Error;
      end case;
    end if;
  end Blue_Value;

  function Alpha_Value(F : PNG_File; R, C : Coordinate) return Natural is
    -- This function may be called for a Type 4 or Type 6 PNG.  Prior to
    -- version 1.3, this function gave incorrect values for Type 4 PNGs
    -- because it did not take account of the PNG type and the offsets
    -- supplied to U8/16 were for Type 6 RGBA images.
  begin
    case F.Colour_Type is
      when 4 =>
        case F.Bit_Depth is
          when  8     => return Natural(U8 (F, R, C, 1));
          when 16     => return Natural(U16(F, R, C, 2));
          when others => raise  Call_Error;
        end case;
      when 6 =>
        case F.Bit_Depth is
          when  8     => return Natural(U8 (F, R, C, 3));
          when 16     => return Natural(U16(F, R, C, 6));
          when others => raise  Call_Error;
        end case;
      when others => raise Call_Error;
    end case;
  end Alpha_Value;

  function Gamma(F : PNG_File) return Boolean is begin return F.Gamma; end;

  function Gamma_Value(F : PNG_File) return Natural is
  begin
    if F.Gamma then return Natural(F.Gamma_Value);
               else raise Call_Error;
    end if;
  end;

  function Chromaticity(F : PNG_File) return Boolean is
  begin
    return F.Chroma;
  end;

  function White_Point(F : PNG_File) return Pair is
  begin
    if F.Chroma then return (Positive(F.White_X), Positive(F.White_Y));
                else raise Call_Error;
    end if;
  end;

  function Red_Primary(F : PNG_File) return Pair is
  begin
    if F.Chroma then return (Positive(F.Red_X), Positive(F.Red_Y));
                else raise Call_Error;
    end if;
  end;

  function Green_Primary(F : PNG_File) return Pair is
  begin
    if F.Chroma then return (Positive(F.Green_X), Positive(F.Green_Y));
                else raise Call_Error;
    end if;
  end;

  function Blue_Primary(F : PNG_File) return Pair is
  begin
    if F.Chroma then return (Positive(F.Blue_X), Positive(F.Blue_Y));
                else raise Call_Error;
    end if;
  end;

  function Standard_RGB(F : PNG_File) return Boolean is
  begin
    return F.SRGB;
  end Standard_RGB;

  function SRGB_Rendering(F : PNG_File) return Rendering_Intent is
  begin
    if F.SRGB then return F.Rendering; else raise Call_Error; end if;
  end SRGB_Rendering;

  function Standard_RGB_Chunk(R : Rendering_Intent) return Chunk is
  begin
    return Chunk'(1, To_Chunk_Name(sRGB),
                  Stream_Element_Array'(1 => Rendering_Intent'Pos(R)), Before_PLTE);
  end Standard_RGB_Chunk;

  function Standard_RGB_Chroma return Chunk is
    use Chromaticity_Data;
  begin
    return Chromaticity_Chunk(D65, BT709_R, BT709_G, BT709_B);
  end Standard_RGB_Chroma;

  function Standard_RGB_Gamma return Chunk is
    -- The gamma value used here is laid down in the PNG Specification V1.2, p22.
  begin
    return Gamma_Chunk(Gamma_2_2);
  end Standard_RGB_Gamma;

  function Physical(F : PNG_File) return Boolean is
  begin
    return F.Physical;
  end;

  function Unit_Unknown(F : PNG_File) return Boolean is
  begin
    if F.Physical then return F.Phys_Unit = 0;
                  else raise Call_Error;
    end if;
  end;

  function Unit_Meter(F : PNG_File) return Boolean is
  begin
    if F.Physical then return F.Phys_Unit = 1;
                  else raise Call_Error;
    end if;
  end;

  function Physical_Value(F : PNG_File) return Pair is
  begin
    if F.Physical then return (Positive(F.Phys_X), Positive(F.Phys_Y));
                  else raise Call_Error;
    end if;
  end;

  function NTexT(F : PNG_File) return Natural is
  begin
    return F.Number_of_Texts;
  end;

  function TextN(F : PNG_File; N : Positive) return Text_Item_Pointer is
    P : Text_Item_Pointer := F.Text_Strings; -- May be null.
  begin
    if N <= F.Number_of_Texts then
      -- We work through the list here in reverse order. If N = F.Text_Strings
      -- we return the first list item, if N = 1 we return the last. (The list
      -- was added to at the head so the first item is the last text string
      -- found in the file.
      for I in 1 .. F.Number_of_Texts - N loop P := P.Link; end loop;
      return P;
    else
      Raise_Exception(Call_Error'Identity, "String index too large.");
    end if;
  end TextN;
  pragma Inline(TextN);

  function Text_Keyword(F : PNG_File; N : Positive) return String is
  begin
    return TextN(F, N).Keyword.all;
  end;

  function Text_String(F : PNG_File; N : Positive) return String is
  begin
    return TextN(F, N).Text_String.all;
  end;

  function Ancillary_Chunk_Count(F : PNG_File) return Natural is
  begin
    return F.Number_of_Chunks;
  end Ancillary_Chunk_Count;

  function Ancillary_Chunk(F : PNG_File; N : Positive) return Chunk is
    P : Chunk_List := F.Ancillary_Chunks; -- May be null.
  begin
    if N <= F.Number_of_Chunks then
      -- We work through the list here in reverse order. If N = F.Number_of_Chunks
      -- we return the first list item, if N = 1 we return the last. (The list
      -- was added to at the head so the first item is the last chunk found in
      -- the file.
      for I in 1 .. F.Number_of_Chunks - N loop P := P.Link; end loop;
      return P.Chnk;
    else
      Raise_Exception(Argument_Error'Identity, "Chunk index too large.");
    end if;
  end Ancillary_Chunk;

  function Name(C : Chunk) return Chunk_Name           is begin return C.Name; end Name;
  function Data(C : Chunk) return Stream_Element_Array is begin return C.Data; end Data;

  procedure Destroy(L : in out Chunk_List) is
    T : Chunk_List;
    procedure Deallocate is new Ada.Unchecked_Deallocation(Chunk_List_Element, Chunk_List);
  begin
    while L /= Null_Chunk_List loop
      T := L; L := L.Link;
      Deallocate(T);
    end loop;
  end Destroy;

  function To_Chunk_List(C : Chunk) return Chunk_List is
  begin
    return new Chunk_List_Element'(C.Size, C, Null_Chunk_List);
  end To_Chunk_List;

  function "&"(Left, Right : Chunk) return Chunk_List is
  begin
    return To_Chunk_List(Left) & Right;
  end "&";

  function "&"(Left : Chunk; Right : Chunk_List) return Chunk_List is
  begin
    return new Chunk_List_Element'(Left.Size, Left, Right);
  end "&";

  function "&"(Left : Chunk_List; Right : Chunk) return Chunk_List is
  begin
    return Left & To_Chunk_List(Right);
  end "&";

  function "&"(Left, Right : Chunk_List) return Chunk_List is
  begin
    if Left = Null_Chunk_List then

      -- The user supplied a null list on the left. We handle this without
      -- complaint and return the right list (which might be null, but not
      -- a problem if it is).

      return Right;
    end if;

    -- Otherwise, we need to feel our way down to the end of the Left list and
    -- tack Right onto the end. If Right is null, this will have no effect.

    declare
      T : Chunk_List := Left;   -- This cannot be null, because
      pragma Assert(T /= null); -- we checked just above.
    begin
      while T.Link /= Null_Chunk_List loop T := T.Link; end loop;
      T.Link := Right;
      return Left;
    end;
  end "&";

  function Ancillary_Chunk(Name  : Chunk_Name;
                           Data  : Stream_Element_Array;
                           Where : Chunk_Position) return Chunk is
    N : constant Unsigned_32 := To_Unsigned_32(Name);
  begin
    if not Ancillary(N) then
      Raise_Exception(Argument_Error'Identity,
        "Chunk name does not denote an ancillary chunk.");
    end if;

    -- If the chunk name is known to PNG_IO, verify the given chunk position.

    if Known_Chunk(N) and then Position(N) /= Where then
      Raise_Exception(Argument_Error'Identity,
        "Position for chunk " & Name & " should be " & Chunk_Position'Image(Position(N)));
    end if;

    return (Data'Length, Name, Data, Where);
  end;

  function Gamma_Chunk(Gamma : Natural := Unity_Gamma) return Chunk is
    -- Perhaps it would be wise to do some sort of sanity check on Gamma?
    -- On the other hand, the PNG specification allows a 4-byte value and
    -- doesn't specify any constraints on the value.
  begin
    return Chunk'(4, To_Chunk_Name(gAMA), To_Buffer_4(Unsigned_32(Gamma)), Before_PLTE);
  end Gamma_Chunk;

  function Text_Chunk(Keyword, Text : String) return Chunk is

    -- This function should create a compressed text chunk if
    -- the text is more than 1024 characters long, but for now
    -- it doesn't. 

    L : constant Stream_Element_Count := Keyword'Length + 1 + Text'Length;

    use Ada.Characters.Latin_1;
  begin

    -- Check the keyword for validity. (ISO standard, Section 11.3.4.2).

    if Keyword'Length = 1                  -- There must be at least one character.
    or else Keyword(Keyword'First) = Space -- Leading spaces are not permitted.
    or else Keyword(Keyword'Last)  = Space -- Trailing spaces ditto.
    then
      Raise_Exception(Data_Error'Identity,
        "Illegal use of spaces in text chunk keyword.");
    end if;
    for I in Keyword'Range loop
      if Keyword(I) = No_Break_Space then
        Raise_Exception(Data_Error'Identity,
          "Illegal non-break space character in text chunk keyword.");
      elsif not Ada.Characters.Handling.Is_Graphic(Keyword(I)) then
        Raise_Exception(Data_Error'Identity,
          "Illegal non-graphic character in text chunk keyword.");
      end if;
    end loop;

    -- All seems OK with the keyword, create the chunk.

    return Chunk'(L, To_Chunk_Name(PNG_IO.tEXt), -- The chunk code, not the parameter Text!
                  To_Stream_Element_Array(Keyword & NUL & Text), Anywhere);
  end Text_Chunk;

  function Chromaticity_Chunk(White_Point,   Red_Primary,
                              Green_Primary, Blue_Primary : Pair) return Chunk is
    D : constant Stream_Element_Array := To_Buffer_4(Unsigned_32(  White_Point.X))
                                       & To_Buffer_4(Unsigned_32(  White_Point.Y))
                                       & To_Buffer_4(Unsigned_32(  Red_Primary.X))
                                       & To_Buffer_4(Unsigned_32(  Red_Primary.Y))
                                       & To_Buffer_4(Unsigned_32(Green_Primary.X))
                                       & To_Buffer_4(Unsigned_32(Green_Primary.Y))
                                       & To_Buffer_4(Unsigned_32( Blue_Primary.X))
                                       & To_Buffer_4(Unsigned_32( Blue_Primary.Y));
  begin
    return Chunk'(D'Length, To_Chunk_Name(cHRM), D, Before_PLTE);
  end Chromaticity_Chunk;

  function Physical_Chunk(Value : Pair; Metre : Boolean) return Chunk is
    D : constant Stream_Element_Array := To_Buffer_4(Unsigned_32(Value.X))
                                       & To_Buffer_4(Unsigned_32(Value.Y))
                                       & To_Stream_Element(Metre);
  begin
    return Chunk'(D'Length, To_Chunk_Name(pHYs), D, Before_IDAT);
  end Physical_Chunk;

  -- Procedures for writing PNG files. There are variants of the user visible generics
  -- for each type of PNG file and for 8-bit and 16-bit sample sizes.
  -- However, most of the actual code for file output is common.

  -- The procedure Write_Chunk is responsible for computing the CRC of the chunk, as
  -- well as the length.

  Null_Stream_Element_Array : constant Stream_Element_Array(1 .. 0) := (others => 0);

  procedure Write_Chunk(F          : in File_Type;
                        Chunk_Code : in Unsigned_32;
                        Chunk_Data : in Stream_Element_Array := Null_Stream_Element_Array) is
  begin
    Write(F, To_Buffer_4(Chunk_Data'Length));
    declare
      CRC : Zlib.Unsigned_32 := 0;
    begin

      -- Convert the chunk code to an array of bytes, and calculate its CRC.

      declare
        CC : constant Buffer_4 := To_Buffer_4(Chunk_Code);
      begin
        Zlib.CRC32(CRC, CC);
        Write(F, CC);
      end;

      -- The chunk data field can be empty (example, the IEND chunk)
      -- in which case a null buffer will be supplied, and we write
      -- nothing to the file.

      if Chunk_Data'Length > 0 then
        Zlib.CRC32(CRC, Chunk_Data);
        Write(F, Chunk_Data);
      end if;

      Write(F, To_Buffer_4(Unsigned_32(CRC)));
    end;
  end Write_Chunk;
  pragma Inline(Write_Chunk);

  procedure Start_File(Filename   : in     String;
                       X, Y       : in     Dimension;
                       CT         : in     Colour_Type_Code;
                       BD         : in     Depth;
                       Interlace  : in     Boolean;
                       F          :    out File_Type;
                       Compressor : in out Zlib.Filter_Type;
                       Level      : in     Zlib.Compression_Level) is

    -- This procedure creates the PNG file and writes the PNG signature and
    -- IHDR chunk to the file.  The chunk data is small, and is constructed
    -- as a constant array on the stack. The procedure also initialises the
    -- Zlib compressor used to compress the IDAT data.

  begin
    Zlib.Deflate_Init(Compressor, Level);
    
    Create(F, Out_File, Filename);
    Write (F, PNG_Signature);
    declare
      Chunk_Data : constant Stream_Element_Array := To_Buffer_4(Unsigned_32(X)) &
                                                    To_Buffer_4(Unsigned_32(Y)) &
                                                    Bit_Depth_Table(BD)         &
                                                    Colour_Type_Table(CT)       &
                                                    0 & -- Compression method.
                                                    0 & -- Filter method.
                                                    To_Stream_Element(Interlace);
    begin
      Write_Chunk(F, IHDR, Chunk_Data);
    end;
  end Start_File;
  pragma Inline(Start_File);
  
  -- Zlib calls the callback procedure below to output compressed data. The callback
  -- is passed to Zlib in each of the procedures Write_PNG_Type_X. Normally the action
  -- of the procedure is to output an IDAT chunk containing whatever data it is given.
  -- However, Zlib passes only two bytes of data on the first call (the Zlib header)
  -- and it would be a shame to output an IDAT chunk with only two bytes of data, so
  -- we cache these two bytes until the next call and output them then. Obviously, the
  -- behaviour of Zlib is subject to change, so we build in some checks on what is
  -- happening, as well as check on the content of the two header bytes, in case any
  -- future changes to Zlib or Zlib_Ada defaults cause a change from the assumed
  -- behaviour. The procedure is generic in order to permit the state information and
  -- the file handle to be declared in the code that sets up the Zlib compressor.
  
  -- The three states in the following types correspond to an initial state before the
  -- first call, the first call (which should pass the two header bytes) and all later
  -- calls, when the default action is taken.
  
  type Zlib_Header_Output_Status is (Not_Yet_Seen, Cached, Output);
  
  subtype Zlib_Header is Stream_Element_Array(1 .. 2);
    
  generic
    F      : in out File_Type;
    Cache  : in out Zlib_Header;
    Status : in out Zlib_Header_Output_Status;
  procedure Write_Compressed_IDAT_Data(Data : in Stream_Element_Array);
  
  procedure Write_Compressed_IDAT_Data(Data : in Stream_Element_Array) is
  begin
    -- It would not be harmful to output a zero length IDAT chunk, but there is
    -- no point in doing so. Versions of Zlib_Ada prior to 1.3 passed zero length
    -- data, and the assertion that follows is just a check that this does not
    -- occur, as it simplifies the rest of the procedure.
    pragma Assert(Data'Length /= 0);
    
    case Status is
      when Not_Yet_Seen => -- This must be the first call. It is possible that only
                           -- one byte has been passed in which case we have a big
                           -- problem, so we check for this with an assertion.
                           
                           pragma Assert(Data'Length > 1);
                           
                           -- Otherwise, we can handle two or more bytes. If there are
                           -- only two, we cache the two bytes until the next call,
                           -- if there are more than two, we output an IDAT chunk.
                           -- Obviously, if Zlib passes three bytes, this results in
                           -- stupid behaviour, but it is likely that 'more than two'
                           -- will, in practice, be a large block of data.

                           Cache := Data(Data'First .. Stream_Element_Offset'Succ(Data'First));
                           
                           -- Check that the two bytes are valid as a Zlib header in a
                           -- PNG file. If not, something in the defaults or parameters
                           -- of Zlib or Zlib_Ada must have changed and PNG_IO needs to
                           -- be modified to suit.
                           
                           pragma Assert(Valid_Zlib_Header(Cache(1), Cache(2)));
                           
                           if Data'Length = 2 then -- This is the expected behaviour.
                             Status := Cached; -- Output the two bytes on the next call.
                           else
                             -- This is plausible behaviour, but not what Zlib does at
                             -- present.
                             Write_Chunk(F, IDAT, Data); -- Output a chunk now, and note
                             Status := Output;           -- that the header has been output.
                           end if;
                           
      when Cached       => -- Prepend the two cached bytes to the data passed on
                           -- this, the second call, and output an IDAT chunk.
                           Write_Chunk(F, IDAT, Cache & Data);
                           Status := Output;

      when Output       => Write_Chunk(F, IDAT, Data); -- Normal action: output a chunk.
    end case;
  end Write_Compressed_IDAT_Data;
  
  procedure Write_Ancillary_Chunks(F : in File_Type;
                                   L : in Chunk_List;
                                   W : Chunk_Position) is
    -- Writes any chunks in L whose positioning matches W.
    P : Chunk_List := L;
  begin
    while P /= null loop
      if P.Chnk.Where = W then Write_Chunk(F, To_Unsigned_32(P.Chnk.Name), P.Chnk.Data); end if;
      P := P.Link;
    end loop;
  end Write_Ancillary_Chunks;
  pragma Inline(Write_Ancillary_Chunks);

  procedure Finish_File(F : in out Ada.Streams.Stream_IO.File_Type) is
    -- This procedure writes a tEXt chunk and the IEND chunk
    -- to the file and closes the file. The tEXt chunk identifies
    -- this software as the creator of the PNG file.
  begin
    Write_Chunk(F, tEXt, To_Stream_Element_Array(Package_Identifier));
    Write_Chunk(F, IEND);
    Close(F);
  end Finish_File;

  generic
    Bpp : in Stream_Element_Offset := 1; -- The offset between corresponding bytes
                                         -- of adjacent pixels within a scanline, as
                                         -- described in Section 6 of the PNG Specification.
  function Adaptive_Filter(Raw, Prior : Stream_Element_Array) return Stream_Element_Array;

  function Adaptive_Filter(Raw, Prior : Stream_Element_Array) return Stream_Element_Array is separate;

  procedure Write_PNG_Type_0(Filename  : in String;
                             I         : in Image_Handle; 
                             X, Y      : in Dimension;
                             Bit_Depth : in Depth   := Eight;
                             Interlace : in Boolean := False;
                             Ancillary : in Chunk_List := Null_Chunk_List;
                             Level     : in Compression_Level := Default_Compression)
                             is separate;

  procedure Write_PNG_Type_2(Filename  : in String;
                             I         : in Image_Handle;
                             X, Y      : in Dimension;
                             Bit_Depth : in Depth_8_16 := Eight;
                             Interlace : in Boolean    := False;
                             Ancillary : in Chunk_List := Null_Chunk_List;
                             Level     : in Compression_Level := Default_Compression)
                             is separate;

  procedure Write_PNG_Type_3(Filename  : in String;
                             P         : in Palette_Handle;
                             I         : in Image_Handle;
                             X, Y      : in Dimension;
                             Interlace : in Boolean := False;
                             Ancillary : in Chunk_List := Null_Chunk_List;
                             Level     : in Compression_Level := Default_Compression)
                             is separate;

  procedure Write_PNG_Type_4(Filename  : in String;
                             I         : in Image_Handle;
                             X, Y      : in Dimension;
                             Bit_Depth : in Depth_8_16 := Eight;
                             Interlace : in Boolean    := False;
                             Ancillary : in Chunk_List := Null_Chunk_List;
                             Level     : in Compression_Level := Default_Compression)
                             is separate;

  procedure Write_PNG_Type_6(Filename  : in String;
                             I         : in Image_Handle;
                             X, Y      : in Dimension;
                             Bit_Depth : in Depth_8_16 := Eight;
                             Interlace : in Boolean    := False;
                             Ancillary : in Chunk_List := Null_Chunk_List;
                             Level     : in Compression_Level := Default_Compression)
                             is separate;
begin

  -- Verify the integrity of the chunk type codes.

  if To_Chunk_Name(IHDR) /= "IHDR"
  or To_Chunk_Name(PLTE) /= "PLTE"
  or To_Chunk_Name(IDAT) /= "IDAT"
  or To_Chunk_Name(IEND) /= "IEND"
  or To_Chunk_Name(cHRM) /= "cHRM"
  or To_Chunk_Name(gAMA) /= "gAMA"
  or To_Chunk_Name(sRGB) /= "sRGB"
  or To_Chunk_Name(pHYs) /= "pHYs"
  or To_Chunk_Name(tEXt) /= "tEXt"
  or To_Chunk_Name(zTXt) /= "zTXt"
  or To_Chunk_Name(tRNS) /= "tRNS"
  or To_Chunk_Name(iCCP) /= "iCCP"
  or To_Chunk_Name(iTXT) /= "iTXt"
  or To_Chunk_Name(bKGD) /= "bKGD"
  or To_Chunk_Name(sBIT) /= "sBIT"
  or To_Chunk_Name(sPLT) /= "sPLT"
  or To_Chunk_Name(hIST) /= "hIST"
  or To_Chunk_Name(tIME) /= "tIME" then
    Raise_Exception(Program_Error'Identity,
      "Internal verification error in chunk codes.");
  end if;

end PNG_IO;