Re: 2d Sprite Engines for Perl

[zentara]

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;
}

[teamster_jr]

is this the original node? a

[zentara]

Yes, thundergnat deserves the credit, and I thank you.