I was going thru some old posts, like Mimicking UNIX Eyes, and since it's too hot today to do anything else, I decided to make a Gtk2 version of Xeyes. Tk will not let you get an external mouse position without

my ($x, $y) = X11::GUITest::GetMousePos();

but Gtk2 allows you to get the root window and it's mouse position with

my $s = Gtk2::Gdk::Screen->get_default;
my $w = $s->get_root_window;
my (undef, $x, $y, $mask) = $w->get_pointer;

So here it is. The Goo::Canvas is used for easy rotations.

#!/usr/bin/perl
use warnings;
use strict;
use Glib qw/TRUE FALSE/;
use Gtk2 -init;
use Goo::Canvas;
use Math::Trig qw( atan pi rad2deg );

# to get mouse pointer at anywhere on screen
my $s = Gtk2::Gdk::Screen->get_default;
my $w = $s->get_root_window;

my $last_heading = -90; # account for default starting position

my $window = Gtk2::Window->new('toplevel');
$window->signal_connect('delete_event' => sub { Gtk2->main_quit; });
$window->set_size_request(200, 200);

my $canvas = Goo::Canvas->new();
$canvas->set_size_request(200, 200);
my $white = Gtk2::Gdk::Color->new (0xFFFF,0xFFFF,0xFFFF);
$canvas->modify_base('normal',$white );
$window->add($canvas);
my $root = $canvas->get_root_item();

my ($midx1, $midy1) = (60,100);
my ($midx2, $midy2) = (140,100);

my $e0 = Goo::Canvas::Ellipse->new(
        $root, 
        $midx1, $midy1, 35, 50, # centerx, centery, width, height
        'stroke-color' => 'black',
        'line-width' => 4
    );

my $e1 = Goo::Canvas::Ellipse->new(
        $root, 
        $midx1, $midy1 - 15, 5, 10, # centerx, centery, width, height
        'stroke-color' => 'blue',
        'line-width' => 16
    );


my $e2 = Goo::Canvas::Ellipse->new(
        $root, $midx2, $midy2, 35, 50,
        'stroke-color' => 'black',
        'line-width' => 4
    );

my $e3 = Goo::Canvas::Ellipse->new(
        $root, 
        $midx2, $midy2 - 15, 5, 10, # centerx, centery, width, height
        'stroke-color' => 'blue',
        'line-width' => 16
    );


my $id = Glib::Timeout->add (100, \&track );


$window->show_all();
Gtk2->main;

sub track { 

#$window->get_origin gives a position in root window coordinates, once
#you get $widget->window.  

# account for window being moved 
my ($xpos, $ypos) = $window->window->get_origin();
my ($xcent, $ycent) = ($xpos + 100, $ypos + 100); 
#print "$xpos $ypos $xcent $ycent \n"; 

# get mouse position
my (undef, $x, $y, $mask) = $w->get_pointer;
#print " $mask  $x $y\n";

# compute angle from window center to mouse 
my $angle = eval{ atan( ( $ycent - $y ) / ( $xcent - $x ) ) } ;
$angle += pi if ( $xcent - $x ) >= 0;
my $heading  = rad2deg($angle);
if ( $heading < 0  ) { $heading += 360 } 

my $delta = $heading - $last_heading;
#print "$heading\n";
#print "$delta\n";

$e1->rotate ($delta , $midx1, $midy1);
$e3->rotate ($delta , $midx2, $midy2);

$last_heading = $heading;

return 1;  # keep this timer going

}
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.