Beefy Boxes and Bandwidth Generously Provided by pair Networks Frank
Syntactic Confectionery Delight
 
PerlMonks  

Strangely addictive Tk::Zinc based game

by thundergnat (Deacon)
on May 05, 2006 at 02:35 UTC ( #547577=sourcecode: print w/ replies, xml ) Need Help??

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


Comment on Strangely addictive Tk::Zinc based game
Download Code
Re: Strangely addictive Tk::Zinc based game
by Hue-Bond (Priest) on May 05, 2006 at 08:59 UTC
    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?

    --
    David Serrano

      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...
Re: Strangely addictive Tk::Zinc based game
by zentara (Archbishop) on May 05, 2006 at 11:24 UTC
    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?


    I'm not really a human, but I play one on earth. flash japh
      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!
        For an extra challenge, try it left-handed. :-)

        I'm not really a human, but I play one on earth. flash japh

      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.

Re: Strangely addictive Tk::Zinc based game
by wazoox (Prior) on May 05, 2006 at 12:07 UTC

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://547577]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (14)
As of 2014-04-21 16:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (496 votes), past polls