Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number

Mimicking UNIX Eyes

by merrymonk (Friar)
on Dec 17, 2009 at 12:57 UTC ( #813178=perlquestion: print w/replies, xml ) Need Help??
merrymonk has asked for the wisdom of the Perl Monks concerning the following question:

Some years ago when using UNIX I used was a small application available that had a face with big eyes.
The eyes followed the cursor as it move around the screen. As it is Christmas, I just wondered if
any Monk had a similar application written using Perl TK that could be shared.

Replies are listed 'Best First'.
Re: Mimicking UNIX Eyes
by zentara (Archbishop) on Dec 17, 2009 at 13:30 UTC
    ... the problem with using Tk to do an eyes like app, is the required global grab of the mouse pointer..... IIRC, Unix Eyes did not interfere with the functioning of the mouse ..... and requires a global mouse grab.... and is not an easy to solve problem cross platform

    ....this almost smells of homework..... so here is some starter code .....for it to work on Tk, it needs window focus .... and you will see the problem as you move the window around...... you could make a full-screen Tk app and use this code to drive balls on a canvas widget.... that would be easy..... but it's your homework ;-)

    #!/usr/bin/perl use warnings; use strict; use Tk; my $mw= tkinit; $mw->bind('<Motion>' => [\&show_position,$mw]); MainLoop; sub show_position{ my $widget = shift; my $x = $widget->pointerx; my $y = $widget->pointery; print "$x $y\n"; # ($x, $y) = $widget->pointerxy; }
    ...if you want a christmas toy, try Newtons-Cradle-Tk-Zinc

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku
      i'm no good at maths
      #!/usr/bin/perl -- use strict; use warnings; use Tk 8; my $mw = tkinit( -width => 500, -height => 500 ); my $canvas = $mw->Canvas()->pack( -expand => 'yes', ); $canvas->createOval( 50, 50, 100, 100, -fill => 'white', -tags => ['le +ft'] ); $canvas->createOval( 60, 50, 70, 60, -fill => 'red', -tags => ['left i +ris'] ); $canvas->createOval( 100 + 50, 50, 100 + 100, 100, -fill => 'white', -tags => ['right'] ); $canvas->createOval( 100 + 80, 80, 100 + 90, 90, -fill => 'red', -tags => ['right iris'] ); $mw->bind( 'Tk::Canvas', '<Motion>' => [ \&marine, Ev('x'), Ev('y') ] +); use Math::Trig qw' atan pi '; sub marine { my ( $w, $x, $y ) = @_; my $iris = 'left iris'; my $r = 25; my $cx = 75; my $cy = 75; my $angle = eval { atan( ( $cy - $y ) / ( $cx - $x ) ) }; $angle += pi if ( $cx - $x ) >= 0; my ( $x1, $y1, $x2, $y2 ) = $w->coords($iris); $x1 = ( ( $r * cos($angle) + $cx ) ); $y1 = ( ( $r * sin($angle) + $cy ) ); $x2 = $x1 + 10; $y2 = $y1 + 10; $w->coords( $iris, $x1, $y1, $x2, $y2 ); } MainLoop;
Re: Mimicking UNIX Eyes
by bv (Friar) on Dec 17, 2009 at 14:41 UTC

      That is an excellent idea, so I did just that. The source is included in the x11-apps package. I got the 8.04/hardy source

      My crude analysis is that xeyes polls the mouse position. It polls frequently when there is mouse activity but then backs off on the polling interval when there is no activity. There is no hook into a mouse handler.

      Thanks to everyone. I will pursue this further.
Re: Mimicking UNIX Eyes
by Kirsle (Pilgrim) on Dec 18, 2009 at 23:29 UTC

    Try the module X11::GUITest. It may help you get the cursor's position in X11. From the readme...

    GetMousePos Returns an array containing the position of the mouse curs +or. my ($x, $y) = GetMousePos();

    Combine this with a simple Tk window for drawing the eyes, and X11::GUITest should help ya get the cursor position so you don't need Tk to handle that part. Of course this approach is only good for X11 systems and isn't cross platform to Windows or OS X.

Re: Mimicking UNIX Eyes
by zentara (Archbishop) on Jul 08, 2012 at 11:24 UTC

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://813178]
Approved by AnomalousMonk
Front-paged by Arunbear
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (3)
As of 2017-03-28 20:47 GMT
Find Nodes?
    Voting Booth?
    Should Pluto Get Its Planethood Back?

    Results (341 votes). Check out past polls.