Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Gtk2 Xeyes

by zentara (Archbishop)
on Jul 07, 2012 at 17:57 UTC ( #980493=CUFP: print w/ replies, xml ) Need Help??

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 }

I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh

Comment on Gtk2 Xeyes
Download Code
Re: Gtk2 Xeyes
by thomas895 (Hermit) on Jul 18, 2012 at 05:29 UTC

    The Goo::Canvas is used for easy rotations.
    Alas, that same Goo:Canvas also refuses to install on my system, because of some dpendancy on "goocanvas". For some reason(YaST didn't say), the installation of "goocanvas" failed, so I'm afraid it won't work for me. :-(

    Oh well, I'm sure it's great :-)

    ~Thomas~
    confess( "I offer no guarantees on my code." );
      The latest version of Goo::Canvas is based on Gtk3, and requires the c libs for Gtk3, and the newer goocanvas c-libs. These can be had at /pub/gnome/sources/goocanvas

      If you are using the older Gtk2, you can install the c -lib goocanvas-0.6,( look for the older 2009 versions), and use the Perl module Goo-Canvas version 0.03.

      The conversion from Gtk2 to Gtk3 is going slow, and is causing problems in library mismatches. I'll try to get a plain old Tk version going . :-)


      I'm not really a human, but I play one on earth.
      Old Perl Programmer Haiku ................... flash japh

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://980493]
Approved by ww
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (7)
As of 2014-08-22 21:08 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (165 votes), past polls