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 | |
by wazoox (Prior) on May 05, 2006 at 11:59 UTC | |
by zentara (Archbishop) on May 05, 2006 at 12:01 UTC | |
by wazoox (Prior) on May 05, 2006 at 12:05 UTC | |
by thundergnat (Deacon) on May 08, 2006 at 17:44 UTC | |
Re: Strangely addictive Tk::Zinc based game
by Hue-Bond (Priest) on May 05, 2006 at 08:59 UTC | |
by wazoox (Prior) on May 05, 2006 at 11:56 UTC | |
Re: Strangely addictive Tk::Zinc based game
by wazoox (Prior) on May 05, 2006 at 12:07 UTC |