# This file is just a list of exports and documentation. The source
# code for this file is in Libpng.xs in the top directory.
package Image::PNG::Libpng;
use warnings;
use strict;
require Exporter;
use Carp;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw/
        access_version_number
        color_type_channels
        color_type_name
        copy_row_pointers
        create_read_struct
        create_write_struct
        destroy_read_struct
        destroy_write_struct
        get_IHDR
        get_PLTE
        get_bKGD
        get_bit_depth
        get_cHRM
        get_cHRM_XYZ
        get_channels
        get_chunk_cache_max
        get_chunk_malloc_max
        get_color_type
        get_compression_buffer_size
        get_eXIf
        get_gAMA
        get_hIST
        get_iCCP
        get_interlace_type
        get_internals
        get_libpng_ver
        get_oFFs
        get_pCAL
        get_pHYs
        get_palette_max
        get_pixel
        get_rgb_to_gray_status
        get_rowbytes
        get_rows
        get_sBIT
        get_sCAL
        get_sPLT
        get_sRGB
        get_tIME
        get_tRNS
        get_tRNS_palette
        get_text
        get_unknown_chunks
        get_valid
        init_io
        init_io_x
        libpng_supports
        permit_mng_features
        read_end
        read_from_scalar
        read_image
        read_info
        read_png
        read_struct
        read_update_info
        scalar_as_input
        set_IHDR
        set_PLTE
        set_add_alpha
        set_alpha_mode
        set_bKGD
        set_back
        set_background
        set_bgr
        set_cHRM
        set_cHRM_XYZ
        set_chunk_cache_max
        set_chunk_malloc_max
        set_compression_buffer_size
        set_compression_level
        set_compression_mem_level
        set_compression_method
        set_compression_strategy
        set_compression_window_bits
        set_crc_action
        set_eXIf
        set_expand
        set_expand_16
        set_expand_gray_1_2_4_to_8
        set_filler
        set_filter
        set_gAMA
        set_gamma
        set_gray_to_rgb
        set_hIST
        set_iCCP
        set_image_data
        set_invert_alpha
        set_invert_mono
        set_keep_unknown_chunks
        set_oFFs
        set_pCAL
        set_pHYs
        set_packing
        set_packswap
        set_palette_to_rgb
        set_quantize
        set_rgb_to_gray
        set_row_pointers
        set_rows
        set_sBIT
        set_sCAL
        set_sPLT
        set_sRGB
        set_scale_16
        set_strip_16
        set_strip_alpha
        set_swap
        set_swap_alpha
        set_tIME
        set_tRNS
        set_tRNS_pointer
        set_tRNS_to_alpha
        set_text
        set_text_compression_level
        set_text_compression_mem_level
        set_text_compression_strategy
        set_text_compression_window_bits
        set_transforms
        set_unknown_chunks
        set_user_limits
        set_verbosity
        sig_cmp
        split_alpha
        text_compression_name
        write_end
        write_image
        write_info
        write_png
        write_to_scalar
        copy_png
        create_reader
        create_writer
        get_contents
        get_internals
        image_data_diff
        png_compare
        read_png_file
        split_alpha
        write_png_file
/;
our %EXPORT_TAGS = (
    all => \@EXPORT_OK,
);
require XSLoader;
our $VERSION = '0.59';
XSLoader::load('Image::PNG::Libpng', $VERSION);
use Image::PNG::Const ':all';
# Old undocumented function name
sub read_file
{
    goto & read_png_file;
}
# Old undocumented function name
sub write_file
{
    goto & write_png_file;
}
sub read_png_file
{
    my ($file_name, %options) = @_;
    my $png = create_read_struct ();
    if ($options{transforms}) {
        $png->set_transforms ($options{transforms});
    }
    if ($options{verbosity}) {
        $png->set_verbosity ($options{verbosity});
    }
    open my $in, "<:raw", $file_name
        or croak "Cannot open '$file_name' for reading: $!";
    $png->init_io ($in);
    $png->read_png ();
    close $in or croak $!;
    return $png;
}
sub write_png_file
{
    my ($png, $file_name) = @_;
    if ($png->read_struct ()) {
        # The following is more convenient but might not work in some
        # cases, depending on how libpng handles different
        # transformations and so on, so I don't really want to risk
        # it.
        # my $copy = $png->copy_png ();
        # write_png_file ($copy, $file_name);
        # return;
        croak "The png is a read structure, use copy_png to copy it to a write structure";
    }
    if (! $file_name) {
        croak "Supply a file name";
    }
    open my $in, ">:raw", $file_name
        or croak "Cannot open '$file_name' for writing: $!";
    $png->init_io ($in);
    $png->write_png ();
    close $in or croak $!;
}
my %known_chunks = (
bKGD => 1,
cHRM => 1,
gAMA => 1,
hIST => 1,
iCCP => 1,
IDAT => 1,
oFFs => 1,
pCAL => 1,
pHYs => 1,
PLTE => 1,
sBIT => 1,
sCAL => 1,
sPLT => 1,
sRGB => 1,
tIME => 1,
tRNS => 1,
);
sub get_chunk
{
    my ($png, $chunk) = @_;
    if ($chunk eq 'IDAT') {
        croak "Use get_rows";
    }
    if ($known_chunks{$chunk}) {
        no strict 'refs';
        my $sub = "get_$chunk";
        return &$sub ($png); 
    }
    return undef;
}
sub set_chunk
{
    my ($png, $chunk, $value) = @_;
    if ($chunk eq 'IDAT') {
        croak "Use set_rows";
    }
    if ($known_chunks{$chunk}) {
        no strict 'refs';
        my $sub = "set_$chunk";
        return &$sub ($png, $value); 
    }
    croak "Unknown chunk $chunk";
}
sub copy_png
{
    my ($png, %options) = @_;
    my $opng = create_write_struct ();
    if ($options{verbosity}) {
        $opng->set_verbosity ($options{verbosity});
    }
    my $strip = $options{strip};
    my $strip_all;
    if ($strip) {
        if ($strip eq 'all') {
            $strip_all = 1;
        }
    }
    my $valid = $png->get_valid ();
    $opng->set_IHDR ($png->get_IHDR ());
    my $rows = $png->get_rows ();
    $opng->set_rows ($rows);
    # Set PLTE up first because hIST needs it to be set.
    if ($valid->{PLTE}) {
        $opng->set_chunk ('PLTE', $png->get_chunk ('PLTE'));
    }
    if (! $strip_all) {
        # Make a list of valid chunks excluding IHDR (header), IDAT
        # (image data), and PLTE (palette).
        my @valid = grep {!/IHDR|IDAT|PLTE/ && $valid->{$_}} sort keys %$valid;
        for my $chunk (@valid) {
            $opng->set_chunk ($chunk, $png->get_chunk ($chunk));
        }
    }
    return $opng;
}
sub width
{
    goto & get_image_width;
}
sub height
{
    goto & get_image_height;
}
sub image_data_diff
{
    my ($file1, $file2, %options) = @_;
    my $transforms = PNG_TRANSFORM_EXPAND | PNG_TRANSFORM_GRAY_TO_RGB;
    my $png1 = read_png_file ($file1, transforms => $transforms);
    my $png2 = read_png_file ($file2, transforms => $transforms);
    my $ihdr1 = $png1->get_IHDR ();
    my $ihdr2 = $png2->get_IHDR ();
    my @fields = qw/height width/;
    for my $field (@fields) {
        print "$field: $ihdr1->{$field} != $ihdr2->{$field}\n";
        if ($ihdr1->{$field} != $ihdr2->{$field}) {
            return "$field differs: $file1: ".
            "$ihdr1->{field}; $file2: $ihdr2->{field}";
        }
    }
    my $h = $ihdr1->{height};
    my $rows1 = $png1->get_rows ();
    my $rows2 = $png2->get_rows ();
    for my $r (0..$h - 1) {
        my $row1 = $rows1->[$r];
        my $row2 = $rows2->[$r];
        if ($row1 ne $row2) {
            if ($options{print_bytes}) {
                my @bytes1 = unpack "C*", $row1;
                my @bytes2 = unpack "C*", $row2;
                for my $byte (0..$#bytes1) {
                    if ($bytes1[$byte] != $bytes2[$byte]) {
                        printf 'byte %0d: %02X,%02X' . "\n", $byte,
                                $bytes1[$byte], $bytes2[$byte];
                    }
                }
                print "\n";
            }
            return "Row $r of image data differs";
        }
    }
    # No difference.
    return undef;
}
sub png_compare
{
    my ($file1, $file2, %options) = @_;
    my $transforms = PNG_TRANSFORM_EXPAND | PNG_TRANSFORM_GRAY_TO_RGB;
    my $png1 = read_png_file ($file1, transforms => $transforms);
    my $png2 = read_png_file ($file2, transforms => $transforms);
    my $ihdr1 = $png1->get_IHDR ();
    my $ihdr2 = $png2->get_IHDR ();
    my @fields = qw/height width/;
    for my $field (@fields) {
        if ($ihdr1->{$field} != $ihdr2->{$field}) {
            return 1;
        }
    }
    my $h = $ihdr1->{height};
    my $rows1 = $png1->get_rows ();
    my $rows2 = $png2->get_rows ();
    for my $r (0..$h - 1) {
        my $row1 = $rows1->[$r];
        my $row2 = $rows2->[$r];
        if ($row1 ne $row2) {
            return 1;
        }
    }
    # No difference.
    return 0;
}
sub create_reader
{
    my ($file) = @_;
    open my $in, "<:raw", $file or croak "Can't open '$file': $!";
    my $png = create_read_struct ();
    $png->init_io ($in);
    return $png;
}
sub create_writer
{
    my ($file) = @_;
    open my $in, ">:raw", $file or croak "Can't open '$file': $!";
    my $png = create_write_struct ();
    $png->init_io ($in);
    return $png;
}
# This is a helper for pnginspect which pulls out the information from
# a PNG file and sticks it into a hash. 
sub get_contents
{
    # The PNG "file" might also be some data pulled from the web and
    # not saved to a file, so the fields $name and $size in the
    # argument list might be a URL and the size of a bit of binary
    # data in Perl's memory.
    my ($png, $name, $size) = @_;
    if (! $name) {
        croak "No name";
    }
    if (! $size || $size !~ /^[0-9]+$/) {
        croak "No size or bad size";
    }
    my %contents;
    $contents{name} = $name;
    $contents{size} = $size;
    $contents{ihdr} = $png->get_IHDR ();
    my $valid = $png->get_valid ();
    for my $key (%$valid) {
        if ($key eq 'IDAT') {
            $contents{IDAT} = 'OK';
        }
        else {
            $contents{$key} = $png->get_chunk ($key);
        }
    }
    $contents{text} = $png->get_text ();
    return \%contents;
}
1;
# Local Variables:
# mode: perl
# End: