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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
#!/usr/bin/perl
=pod
GdkPixbuf is a client-side image data object; in C you just deal with 24-bit
RGB or 32-bit RGBA image data, but in Perl such things are a little difficult.
This code shows how to find pixels within a GdkPixbuf, as well as how to
create new GdkCursors.
-- muppet, 3 March 04
=cut
use strict;
use warnings;
use Glib qw(FALSE TRUE);
use Gtk2 -init;
die "Usage: $0 imagefile\n" unless @ARGV;
my $pixbuf = Gtk2::Gdk::Pixbuf->new_from_file ($ARGV[0]);
# grab this now, so we only keep one copy of it.
my $pixels = $pixbuf->get_pixels;
# create a bunch of widgets...
my $window = Gtk2::Window->new;
my $hbox = Gtk2::HBox->new;
my $ebox = Gtk2::EventBox->new;
my $align = Gtk2::Alignment->new (0.5, 0.5, 0.0, 0.0);
my $image = Gtk2::Image->new_from_pixbuf ($pixbuf);
my $frame = Gtk2::Frame->new ('Color');
my $vbox = Gtk2::VBox->new;
my $label = Gtk2::Label->new;
my $darea = Gtk2::DrawingArea->new;
# lay 'em out...
$window->add ($hbox);
$ebox->add ($image);
$align->add ($ebox);
$hbox->add ($align);
$hbox->pack_start ($frame, FALSE, FALSE, 0);
$frame->add ($vbox);
$vbox->pack_start ($label, FALSE, FALSE, 0);
$vbox->pack_start ($darea, FALSE, FALSE, 0);
# hook 'em up...
$window->set_title ("Color Snooper");
$window->show_all;
$window->signal_connect (delete_event => sub {Gtk2->main_quit;});
$darea->set_size_request (64, 64);
$ebox->window->set_cursor (create_cursor());
$ebox->add_events (['pointer-motion-mask', 'pointer-motion-hint-mask']);
$ebox->signal_connect (motion_notify_event => sub {
my ($widget, $event) = @_;
# this is so we keep getting pointer events.
$widget->window->get_pointer;
# the Gtk2::Image is a no-window widget; translate its coords.
# it should be packed tightly in the event box, thanks to the
# alignment, but this is for paranoia's sake.
my ($x, $y) = $widget->translate_coordinates ($image,
$event->x, $event->y);
# the image data is packed RGB or RGBA data. if we can calculate
# the location of our pixel-of-interest, then we can use substr
# and unpack to get to its values.
my ($r, $g, $b, $a) =
unpack "C*",
substr $pixels,
$pixbuf->get_rowstride * $y
+ $pixbuf->get_n_channels * $x,
$pixbuf->get_n_channels;
$label->set_text ("x,y: ".$event->x.", ".$event->y."\n"
."R: $r\n"
."G: $g\n"
."B: $b"
.($pixbuf->get_has_alpha ? "\nA: $a" : ""));
# GdkColors use 16-bit color values, but GdkPixbufs use 8-bit.
# note the bitshifts to account for that.
my $color = Gtk2::Gdk::Color->new ($r << 8, $g << 8, $b << 8);
$darea->modify_bg ('normal', $color);
$darea->queue_draw;
});
# and go.
Gtk2->main;
sub create_cursor {
# these icons borrowed from the gimp.
use constant width => 32;
use constant height => 32;
use constant x_hot => 13; # the tip of the dropper, coords
use constant y_hot => 30; # picked out by hand.
my $dropper_small_bits = pack 'C*',
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x1c, 0x00, 0x00, 0x00, 0x22, 0x00, 0x00, 0x00, 0x41,
0x00, 0x00, 0xc0, 0xa1, 0x00, 0x00, 0x20, 0xbc, 0x00, 0x00, 0x40, 0xbb,
0x00, 0x00, 0x80, 0x44, 0x00, 0x00, 0x40, 0x34, 0x00, 0x00, 0x20, 0x13,
0x00, 0x00, 0x90, 0x15, 0x00, 0x00, 0xc8, 0x00, 0x00, 0x00, 0x64, 0x00,
0x00, 0x00, 0x32, 0x00, 0x00, 0x00, 0x19, 0x00, 0x00, 0x80, 0x0c, 0x00,
0x00, 0x40, 0x06, 0x00, 0x00, 0x40, 0x03, 0x00, 0x00, 0xe0, 0x01, 0x00,
0x00, 0x20, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00;
my $dropper_small_mask_bits = pack 'C*',
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x1c, 0x00, 0x00, 0x00, 0x3e, 0x00, 0x00, 0x00, 0x7f,
0x00, 0x00, 0xc0, 0xff, 0x00, 0x00, 0xe0, 0xff, 0x00, 0x00, 0xc0, 0xff,
0x00, 0x00, 0xc0, 0x7f, 0x00, 0x00, 0xe0, 0x3f, 0x00, 0x00, 0xf0, 0x1f,
0x00, 0x00, 0xf8, 0x1f, 0x00, 0x00, 0xfc, 0x01, 0x00, 0x00, 0xfe, 0x00,
0x00, 0x00, 0x7f, 0x00, 0x00, 0x80, 0x3f, 0x00, 0x00, 0xc0, 0x1f, 0x00,
0x00, 0xe0, 0x0f, 0x00, 0x00, 0xe0, 0x07, 0x00, 0x00, 0xf0, 0x03, 0x00,
0x00, 0xe0, 0x01, 0x00, 0x00, 0x40, 0x00, 0x00;
my $icon = Gtk2::Gdk::Bitmap->create_from_data
(undef, $dropper_small_bits, width, height);
my $mask = Gtk2::Gdk::Bitmap->create_from_data
(undef, $dropper_small_mask_bits, width, height);
return Gtk2::Gdk::Cursor->new_from_pixmap
($icon, $mask,
Gtk2::Gdk::Color->new (0, 0, 0),
Gtk2::Gdk::Color->new (65535, 65535, 65535),
x_hot, y_hot);
}
|
