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