Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
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; }

In reply to Strangely addictive Tk::Zinc based game by thundergnat

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (3)
As of 2022-05-24 03:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you prefer to work remotely?



    Results (82 votes). Check out past polls.

    Notices?