in reply to Mimicking UNIX Eyes

... 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;
}

[download]
...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

Replies are listed 'Best First'.
Re^2: Mimicking UNIX Eyes
by Anonymous Monk on Dec 17, 2009 at 14:37 UTC
    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;

    [download]
[reply]
[d/l]

In Section Seekers of Perl Wisdom