#!/usr/bin/perl -w
use strict;
use Gtk2::TestHelper tests => 23;
{
my $visual = Gtk2::Gdk::Visual->get_system;
my $image = Gtk2::Gdk::Image->new ('normal', $visual, 7, 8);
is ($image->get_image_type, 'normal', "get_image_type()");
is ($image->get_visual, $visual, "get_visual()");
ok ($image->get_byte_order, "get_byte_order()");
is ($image->get_width, 7, "get_width()");
is ($image->get_height, 8, "get_height()");
is ($image->get_depth, $visual->depth, "get_depth()");
cmp_ok ($image->get_bytes_per_pixel, '>', 0, "get_bytes_per_pixel()");
cmp_ok ($image->get_bytes_per_line, '>', 0, "get_bytes_per_line()");
cmp_ok ($image->get_bytes_per_line, '>=', $image->get_bytes_per_pixel,
"bytes_per_line >= bytes_per_pixel");
cmp_ok ($image->get_bits_per_pixel, '>', 0, "bits_per_pixel");
cmp_ok (8 * $image->get_bytes_per_pixel, '>=', $image->get_bits_per_pixel,
"8 * bytes_per_pixel >= bits_per_pixel");
is ($image->get_colormap, undef, "no initial colormap");
my $new_colormap = Gtk2::Gdk::Colormap->new ($visual, 1);
$image->set_colormap ($new_colormap);
is ($image->get_colormap, $new_colormap, "get_colormap");
my $mem = $image->get_pixels;
is (length($mem), $image->get_bytes_per_line * $image->get_height,
"get_pixels() length");
}
{
require Scalar::Util;
my $visual = Gtk2::Gdk::Visual->get_system;
my $image = Gtk2::Gdk::Image->new ('normal', $visual, 10, 10);
Scalar::Util::weaken ($image);
is ($image, undef, 'image destroyed on weaken');
}
{
my $visual = Gtk2::Gdk::Visual->get_system;
my $image = Gtk2::Gdk::Image->new ('normal', $visual, 10, 10);
my $colormap1 = Gtk2::Gdk::Colormap->new ($visual, 1);
my $colormap2 = Gtk2::Gdk::Colormap->new ($visual, 1);
$image->set_colormap ($colormap1);
is ($image->get_colormap, $colormap1, "get_colormap");
$image->set_colormap ($colormap2);
is ($image->get_colormap, $colormap2, "get_colormap");
Scalar::Util::weaken ($image);
is ($image, undef, 'image destroyed on weaken');
Scalar::Util::weaken ($colormap1);
is ($image, undef,
"colormap1 destroyed on weaken (image doesn't hang onto it)");
Scalar::Util::weaken ($colormap2);
is ($image, undef,
"colormap2 destroyed on weaken (image doesn't hang onto it)");
}
{
my $visual = Gtk2::Gdk::Visual->get_system;
my $image = Gtk2::Gdk::Image->new ('normal', $visual, 10, 10);
# pixel values 0 and 1 are always available, even on a depth==1 monochrome
# visual
$image->put_pixel (5,6, 0);
is ($image->get_pixel(5,6), 0, "get_pixel");
$image->put_pixel (5,6, 1);
is ($image->get_pixel(5,6), 1, "get_pixel");
$image->put_pixel (5,6, 0);
is ($image->get_pixel(5,6), 0, "get_pixel");
}
__END__
Copyright (C) 2010 by the gtk2-perl team (see the file AUTHORS for the
full list). See LICENSE for more information.