http://www.perlmonks.org?node_id=547577
Category: Fun Stuff
Author/Contact Info thundergnat
Description:

I've been puttering around with the Tk::Zinc package, trying to get a handle on it and decided to do a little simulation of a ball in a gravity field. I set up the mouse pointer to be a "point source anti-gravity field". It is strangely addictive to try to keep the ball aloft by repelling it with the mouse cursor.

To make it interesting, the "anti-gravity" field strength decreases over time, so it becomes more and more difficult to keep the ball up. 10 seconds is simple, 20 easy, 30 hard, 40 difficult and 50 plus nearly impossible. The tested limit, (when the "antigravity is too weak to support the ball,) is at 75 seconds, but it would take someone with the reflexes of a fast twitch FPS god to get much over 60 seconds. My personal best is 42 seconds.

Requires Tk::Zinc.

Update: Rewrote it a bit to do less calulations inside the loop. Added automatic update speed detection to set the update speed to a value appropriate for your system. Override automatic speed detection by passing in a delay value in milliseconds at the command line. (20 to 80 ms range recommended.)

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