Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
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;
}


Replies are listed 'Best First'.
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 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 wazoox (Prior) on May 05, 2006 at 12:07 UTC
Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://547577]
help
Chatterbox?
[atcroft]: james28909: What about October 5, 1582?
[stevieb]: atcroft: "Make both hands into fists..."... is something my Ma taught me in our native lang, but I was to ignorant and young to pay attention. Thanks for that :)
[atcroft]: stevieb: Sad to say that I only recently learned that particular trick, but I have since found it very useful.... :)
[james28909]: ill be back with a solution eventually
[stevieb]: it's a reminder to re-inforce it :P
[atcroft]: james28909: That particular questions was a bit of trick, actually (depending on the country you are in). More interesting is, if you are trying to subtract from an epoch time, for instance, you might have to consider when/if DST occurs for a location,
[atcroft]: because you may have to adjust the number of seconds you change from an epoch from 86400 (not to mention leap seconds)....
[atcroft]: james28909: Although if your program is using a database, you might be able to "pass the buck" to the database and ask it to do the date change for you....

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (3)
As of 2017-04-29 04:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    I'm a fool:











    Results (531 votes). Check out past polls.