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

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
Well I just have to throw in a plug for Tk::Zinc. :-) The nice thing about Zinc, is you can get persistent objects to play with, instead of SDL's sprite. I can't find the original node, for this cool Zinc game, but it was written by a fellow perlmonk thundergnat a few months back.
#!/usr/bin/perl use warnings; use strict; use Tk; use Tk::Zinc; use Time::HiRes qw( gettimeofday tv_interval ); my $mw = MainWindow->new; my ( $window_width, $window_height ) = ( 800, 600 ); $mw->geometry("${window_width}x$window_height"); $mw->resizable(0,0); $mw->update; my $zframe = $mw->Frame->pack( -expand => 1, -fill => 'both' ); my $zinc = $zframe->Zinc( -backcolor => 'black', -render => 1 )->pack( -fill => 'both', -expand => 1, ); my ( %ball, %wall, %time ); my $delay = 40; my $gravity = 1.5; my $repel_start = $gravity * .1; my $repel = $repel_start; $ball{velocity} = [ 4, -20 ]; my $top = 30; my $bottom = $window_height - $top; my $left = $top; my $right = $window_width - $left; 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;50 0|#f700f7;50 48|#900090;50 80|# +ab00ab;50 100', '=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; $mw->repeat( $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; $repel -= .00005; #power de +cay my $elasped = tv_interval( [ $time{current}{value} ], [gettimeofda +y] ); my $percent = sprintf "%.1f", $repel / $repel_start * 100; $zinc->itemconfigure( $time{current}{widget}, -text => ( sprintf "Current %.2f Secs.", $elasped ) ); $zinc->itemconfigure( $time{power}{widget}, -text => "$percent% Po +wer" ); if ( $time{high}{value} < $elasped ) { $time{high}{value} = $elasped; $zinc->itemconfigure( $time{high}{widget}, -text => ( sprintf "High %0.2f : $percent%%", $elasped ) +); } 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 $hypotenuse = ( $y_component**2 + $x_component**2 )**.5; $yimpulse = $y_component * 800 / $hypotenuse**2 * $repel; $ximpulse = $x_component * 800 / $hypotenuse**2 * $repel; } $dx *= .99; # a little velocity decay. $dy *= .99; if ( ( $x - $ball{radius} + $dx < $left ) or ( $x + $ball{radius} + $dx > $right ) ) { $dx = -$dx; reset_time( $elasped, $percent ); } if ( ( $y - $ball{radius} + $dy < $top ) or ( $y + $ball{radius} + $dy > $bottom ) ) { $dy = -$dy * .75; reset_time( $elasped, $percent ); } $zinc->translate( $ball{widget}, $dx, $dy ); $dy += ( ( $gravity**2 ) / 2 ) + $yimpulse; $dx += $ximpulse; my ( $x0, $y0, $x1, $y1 ) = $zinc->bbox( $ball{widget} ); $ball{position} = [ ( $x0 + $x1 ) / 2, ( $y0 + $y1 ) / 2 ]; $ball{velocity} = [ $dx, $dy ]; } sub reset_time { my ( $elasped, $percent ) = @_; printf "%.2f Seconds : %.1f%% Power\n", $elasped, $percent if $elasped > 10; $time{current}{value} = gettimeofday; $repel = $repel_start; }

I'm not really a human, but I play one on earth. Cogito ergo sum a bum

In reply to Re: 2d Sprite Engines for Perl by zentara
in thread 2d Sprite Engines for Perl by friedo

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



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

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

    How do I use this? | Other CB clients
    Other Users?
    Others wandering the Monastery: (8)
    As of 2014-10-24 17:05 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      For retirement, I am banking on:










      Results (133 votes), past polls