use warnings;
use strict;
use Tk;
use Tk::Zinc;
use Time::HiRes qw( gettimeofday tv_interval );

my ( $window_width, $window_height ) = ( 1000, 800 );
my $top    = 30;
my $bottom = $window_height - $top;
my $left   = $top;
my $right  = $window_width - $left;

my ( %ball, %wall, %time, %parameter );

my $delay_init = 0;
$ball{velocity} = [ 0, 0 ];

if ( $ARGV[0] and $ARGV[0] !~ /\D/ ) {
    $delay_init = $ARGV[0];
    set_parameters($delay_init);
}
elsif ( $ARGV[0] and $ARGV[0] =~ /\D/ ) {
    die
"Pass a numeric delay in milliseconds to override auto update speed de
+tection.
Something in the range 20-80 is recommended. For example:\n$0 50\n";
}
else {
    set_parameters(50);
}

my $mw = MainWindow->new;

$mw->geometry("${window_width}x$window_height");

$mw->resizable( 0, 0 );

my $zframe = $mw->Frame->pack( -expand => 1, -fill => 'both' );

my $zinc = $zframe->Zinc(
    -backcolor => 'black',
    -render    => 1
  )->pack(
    -fill   => 'both',
    -expand => 1,
  );

my $group = $zinc->add( 'group', 1, -visible => 1 );

{
    $ball{radius} = 20;
    my $x = $window_width / 2;
    my $y = $window_height / 2;
    $ball{position} = [ $x, $y ];

    $ball{widget} = $zinc->add(
        'arc', $group,
        [
            [ $x - $ball{radius}, $y - $ball{radius} ],
            [ $x + $ball{radius}, $y + $ball{radius} ]
        ],
        -filled    => 1,
        -fillcolor =>
          '=radial -20 -20|#ffffff 0|#f700f7 48|#900090 80|#ab00ab 100
+',
        -linewidth => 0,
        -visible   => 1,
    );
}

$wall{widget} = $zinc->add(
    'curve', $group,
    [
        [ $left,  $top ],
        [ $right, $top ],
        [ $right, $bottom ],
        [ $left,  $bottom ],
        [ $left,  $top ]
    ],
    -linecolor => '#00ff00',
    -linewidth => 6,
    -priority  => 100,
    -visible   => 1,
);

$time{current}{widget} = $zinc->add(
    'text', $group,
    -position => [ $window_width / 8, 0 ],
    -color    => '#c0c000',
    -font     => "Times 14",
    -visible  => 1,
);

$time{power}{widget} = $zinc->add(
    'text', $group,
    -position => [ $window_width / 8 * 3, 0 ],
    -color    => '#c0c000',
    -font     => "Times 14",
    -visible  => 1,
);

$time{high}{widget} = $zinc->add(
    'text', $group,
    -position => [ $window_width / 8 * 5, 0 ],
    -color    => '#c0c000',
    -font     => "Times 14",
    -visible  => 1,
);

$zframe->bind( '<Enter>' => sub { $zframe->configure( -cursor => 'dot'
+ ) } );
$zframe->bind( '<Leave>' => sub { $zframe->configure( -cursor => 'arro
+w' ) } );

$time{current}{value} = gettimeofday;
$time{high}{value}    = 0;

my $repeat = $mw->repeat( $parameter{delay}, \&update );

MainLoop;

sub update {
    my ( $x,  $y )  = @{ $ball{position} };
    my ( $dx, $dy ) = @{ $ball{velocity} };
    my ( $mx, $my ) =
      ( $mw->pointerx - $mw->x, $mw->pointery - $mw->y );    # mouse p
+osition
    my $ximpulse = 0;
    my $yimpulse = 0;
    $parameter{repel} -= $parameter{repel_decay};            #power de
+cay
    my $elapsed = tv_interval( [ $time{current}{value} ], [gettimeofda
+y] );
    $zinc->itemconfigure( $time{current}{widget},
        -text => ( sprintf "Current %.2f Secs.", $elapsed ) );
    my $percent = sprintf "%.1f",
      $parameter{repel} / $parameter{repel_start} * 100;
    $zinc->itemconfigure( $time{power}{widget}, -text => "$percent% Po
+wer" );

    if ( $time{high}{value} < $elapsed ) {
        $time{high}{value} = $elapsed;
        $zinc->itemconfigure( $time{high}{widget},
            -text => ( sprintf "High  %0.2f : $percent%%", $elapsed ) 
+);
    }

    if (    $my > $top - $ball{radius}
        and $my < $bottom + $ball{radius}
        and $mx > $left - $ball{radius}
        and $mx < $right + $ball{radius} )
    {
        my $y_component = $y - $my;
        my $x_component = $x - $mx;
        my $impulse     = $parameter{repel} * $parameter{delay}**.3 * 
+150 /
          ( $y_component**2 + $x_component**2 );
        $yimpulse = $y_component * $impulse;
        $ximpulse = $x_component * $impulse;
    }
    $dx *= .99;    # a little velocity decay.
    $dy *= .99;

    if (   ( $x - $ball{radius} + $dx < $left )
        or ( $x + $ball{radius} + $dx > $right ) )
    {
        $dx = -$dx;
        reset_time( $elapsed, $percent );
    }
    if (   ( $y - $ball{radius} + $dy < $top )
        or ( $y + $ball{radius} + $dy > $bottom ) )
    {

        $dy = -$dy * .75;
        reset_time( $elapsed, $percent );
    }

    $zinc->translate( $ball{widget}, $dx, $dy );

    $dy += $parameter{gravity} + $yimpulse;
    $dx += $ximpulse;

    my ( $x0, $y0, $x1, $y1 ) = $zinc->bbox( $ball{widget} );
    $ball{position} = [ ( $x0 + $x1 ) / 2, ( $y0 + $y1 ) / 2 ];
    $ball{velocity} = [ $dx, $dy ];
    unless ( $delay_init and $elapsed ) {
        $delay_init = $elapsed;
        set_parameters( int( $delay_init * 250 ) );
        $repeat->cancel;
        $mw->repeat( $parameter{delay}, \&update );
    }
}

sub reset_time {
    my ( $elapsed, $percent ) = @_;
    printf "%.2f Seconds : %.1f%% Power\n", $elapsed, $percent
      if $elapsed > 10;
    $time{current}{value} = gettimeofday;
    $parameter{repel} = $parameter{repel_start};
}

sub set_parameters {
    $parameter{delay}       = shift;
    $parameter{gravity}     = $parameter{delay} / 15;
    $parameter{repel_start} = $parameter{gravity}**.5 / 3;
    $parameter{repel}       = $parameter{repel_start};
    $parameter{repel_decay} =
      $parameter{repel_start} / ( 70000 / $parameter{delay} );
    print "Delay set to $parameter{delay} ms.\n\n" if $delay_init;
}
[download]