1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
#
# $Header: /cvsroot/gtk2-perl/gtk2-perl-xs/Gtk2/t/GdkColor.t,v 1.4 2004/02/27 05:31:48 muppetman Exp $
#
#########################
# GdkColor Tests
# - muppet
#########################
use Gtk2::TestHelper tests => 17;
my $cmap = Gtk2::Gdk::Colormap->get_system;
ok ($cmap, 'system colormap');
my $visual = $cmap->get_visual;
ok ($visual, 'got a visual');
my $tmp_cmap = Gtk2::Gdk::Colormap->new ($visual, 1);
ok ($tmp_cmap, 'new colormap');
SKIP: {
skip 'get_screen is new in 2.2', 1
unless Gtk2->CHECK_VERSION (2, 2, 0);
ok ($cmap->get_screen, 'got a screen');
}
# ten random colors
my @colors = map {
Gtk2::Gdk::Color->new (rand (65535), rand (65535), rand (65535))
} 0..9;
is ($colors[0]->pixel, 0, 'before alloc_color, pixel is 0');
$cmap->alloc_color ($colors[0], 0, 1);
ok ($colors[0]->pixel > 0, 'alloc_color allocated a color');
my @success = $cmap->alloc_colors (0, 1, @colors);
is (@success, @colors, 'same number of status values as input colors');
ok ($colors[1]->pixel > 0, 'alloc_colors allocated a color');
my $c = $cmap->query_color ($colors[0]->pixel);
ok($c, 'query_color does something');
$cmap->free_colors (@colors);
ok (1, 'free_colors didn\'t coredump');
my $black = Gtk2::Gdk::Color->parse("Black");
ok ($black, 'Black parsed ok');
ok ($black->equal($black), 'Black == Black');
is ($black->hash, 0, 'Black\'s hash == 0');
like($black->pixel, qr/^\d+$/);
is($black->red, 0);
is($black->green, 0);
is($black->blue, 0);
__END__
Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the
full list). See LICENSE for more information.
|
