Strangely addictive Tk::Zinc based game
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 detection.
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( '' => sub { $zframe->configure( -cursor => 'dot' ) } );
$zframe->bind( '' => sub { $zframe->configure( -cursor => 'arrow' ) } );
$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 position
my $ximpulse = 0;
my $yimpulse = 0;
$parameter{repel} -= $parameter{repel_decay}; #power decay
my $elapsed = tv_interval( [ $time{current}{value} ], [gettimeofday] );
$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% Power" );
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;
}
Re: Strangely addictive Tk::Zinc based game
created: 2006-05-05 04:59:35
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
Re^2: Strangely addictive Tk::Zinc based game
created: 2006-05-05 07:56:51
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
created: 2006-05-05 07:24:34
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.
I'm not really a human, but I play one on earth. flash japh
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
Re^2: Strangely addictive Tk::Zinc based game
created: 2006-05-05 07:59:34
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!
Re^3: Strangely addictive Tk::Zinc based game
created: 2006-05-05 08:01:37
Re^2: Strangely addictive Tk::Zinc based game
created: 2006-05-08 13:44:32
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.