Strangely addictive Tk::Zinc based game

[thundergnat]

Category:

Fun Stuff

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

[zentara]

I could only manage 5 seconds. :-) The ball really moved fast on my machine. My cpu usage never went above 5%. Maybe your high cpu usage has something to do with the amount of video card( and/or ram) you have? I have a 2Ghz Athlon, 1 gig ram, and 128 meg Radeon video card.

You probably could incorparate a variable delay, selectable by the user. If I set the delay up to 40, it was more fun. Maybe you could test the system somehow, by seeing how fast the ball moves during a delay period, and automagically set the initial delay. Then have the delay decrease as the game goes on?

[wazoox]

You're right, zentara! With a delay of 40, the game is much more playable and fun, and I kept the ball floating 36.41 s at the first try!

[zentara]

For an extra challenge, try it left-handed. :-)

[thundergnat]

Good point. It worked ok on both of my systems (2.2Gh Intel running Win2k and AMD 3500+ running WinXP/Ubuntu Linux) but it probably is a good idea to try to detect the system speed and adjust the delay accordingly.

I have made some updates to the script to automatically detect the speed and derive all of the parameters from the delay value to make the gameplay comparible across a fairly wide delay range.

[Hue-Bond]

The tested limit, (when the "antigravity is too weak to support the ball,) is at 75 seconds

Strangely, I managed to sustain the ball in the air for 94 seconds. CPU is constantly at 100% and the frame rate is rather poor, could this have something to do?

[wazoox]

Well that's the contrary for me : CPU usage is around 1%, animation is very fluid and... keeping the ball up for 10 seconds is absurdly difficult :) My best now is 8.67...

[wazoox]

Indeed, Tk::Zinc rocks :)