#!/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);
}