Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Perl/Tk Space Invaders Game/Sprite Class

by clintp (Curate)
on Nov 13, 2001 at 00:47 UTC ( #124912=sourcecode: print w/ replies, xml ) Need Help??

Category: Fun Stuff
Author/Contact Info Clinton Pierce, clintp@geeksalad.org PMID: "clintp"
Description: Small Space Invaders game, intended as a demo of a Sprite class for a lecture I give. Feel free to critique, comment, and re-use.
#!/usr/bin/perl -w
use strict;

=head1 NAME

Invaders -- A Space Invaders Game

=head1 DESCRIPTION

A small application to test out a Sprite class that I'm using 
for another project.  The documentation applies to the Sprite
class.  The NOTES below will address the game, as well as inline
coments.

(c) Clinton Pierce 2001

Feel free to redistribute.  Enjoy!

=head1 EXAMPLE

    my $s=new Sprite();
    $s->name('spaceship', 'player1');
    $s->image($shipdata);
    $s->place(10,10);
    
    if ($s->collide()=~/asteroid/) {
        $s->image($blowup, 1);
        sleep(2);
        $s->delete();
    }


=over 4

=cut

package Sprite;

=item $Sprite::keycode

These keypress codes work for Windows and Linux (XFree86).
There''s problems, of course, with using these to control a 
game.  See IMPROVEMENTS below.

=cut

$Sprite::keycode::left=($^O=~/Win32/)?37:100;
$Sprite::keycode::right=($^O=~/Win32/)?39:102;
$Sprite::keycode::fire=($^O=~/Win32/)?17:37;

=item C<new>

Create a new sprite.

=item C<names([spritenames...])>

Assigns a name to the sprite.  Calling with no arguments
returns the names.  Calling with a list of strings assigns those
names to the sprite.

=item C<image(imagedata, [changeflag])>

Create a sprite with an image.  If changeflag is true, then
the existing sprite is overwritten with the new image.

=item C<delete>

Remove the sprite

=item C<draw( createPolygon_args... )>

Calls createPolygon to draw a new object here.

=item C<place( x, y )>

Place the image at the specified location.

=item C<collide>

Will return a string of comma-separated sprite names that the 
current object is touching.  So if:
    
    $rocketship->collide()=~/asteroid/

You''d want to blow up.  Note: You''re always in collision with
yourself.

=back

=cut 

sub new {
    my($class, $canvas)=@_;
    my $self={ canvas => $canvas, id => "", names => []  };
    bless $self, $class;
}
sub names {
    my($self,@names)=@_;
    return @{$self->{names}} unless (@names);
    $self->{names}=[@names];
    foreach(@names) {
        $self->{canvas}->addtag($_, 'withtag', $self->{id} );
    }
}
sub image {
    my($self, $bitmap, $change)=@_;  # -data takes base-64 encoded.
    my $pic=$self->{canvas}->Photo(-data => $bitmap, -format => 'gif')
+;
    $self->{picture}=$pic;
    if (! $change) {
        $self->{id}=$self->{canvas}->createImage(0, 0,
            -image => $pic, -tags => [ @{$self->{names}} ]);
    } else {
        $self->{canvas}->itemconfigure($self->{id}, -image => $pic);
    }
}
sub remove { $_[0]->{canvas}->delete($_[0]->{id}); }
sub draw {
    my($self,@args)=@_;
    $self->{id}=$self->{canvas}->createPolygon(@args,
        -tags => [ @{$self->{names}} ]);
}
sub place {
    my($self, $x, $y)=@_;
    if (! defined $x) {
        return(@{$self->{coord}});
    }
    $self->{canvas}->coords($self->{id}, $x, $y);
    $self->{coord}=[$x,$y];
}

sub collide {
    join ',', map
            { $_[0]->{canvas}->gettags($_) }
        $_[0]->{canvas}->find('overlapping',
            $_[0]->{canvas}->bbox(($_[0]->names)[0]));
}

=head1 GAME

Left/Right arrow moves the ship, Control key fires.  Alien
bombs or aliens reaching the bottom of the screen will kill you.
To reset, kill the app and start again.

=head1 IMPROVEMENTS

All kinds of improvements can be made trivially
(with 3 or fewer lines of code):

    * limited number of shots onscreen at once.
          (this cures one sure-fire winning strategy.)
    * make aliens shoot more when there are fewer 
      of them.
    * make aliens faster when there are fewer of
      them.
    * "mothership" hovering above for bonus points
    * animate the aliens.
    * missles should have some momentum after being 
      released.
          (this kills the other.)
    * missles should themselves blow up

Some less trivially (still fewer than 20 lines):

    * independant movement of aliens left/right,
      up/down
    * "galaxian" style swooping aliens
    * multiple lives
    * etc...

Control difficulties:

    * Pressing "fire" stops left/right movement.
      perhaps someone with a better understanding of
      X11/Tk key bindings can help with this.

=cut

package main;

use Tk;
use Tk::Photo;
my $id=0;
my $left=5;
my $right=300;
my $top=10;
my $bot=280;
my $alienmove=2;
my $score=0;
my $mw=new MainWindow();
my $c=$mw->Canvas(-background => 'black', -height => $bot,
     -width => $right)->pack(-fill => 'both', -expand => 'true');
my($f,%img)=("");
while(<DATA>) {
    chomp;
    if (/^begin\s(.*)/) { $f=$1; next; }
    if (/^N(\d+)N$/) {  $_.=("/"x78)x$1; } # Compression
    $img{$f}.=$_;
}

# Left & right edges
my $le=new Sprite($c);
$le->draw($left,$top,$left,$bot,$left+1,$bot,$left+1,$top,$left,$top,
    -fill => 'black');
$le->names('left');
my $re=new Sprite($c);
$re->draw($right,$top,$right,$bot,$right+1,$bot,$right+1,$top,$right,$
+top,
    -fill => 'black');
$re->names('right');
my $be=new Sprite($c);
$be->draw(0,230,$right,230);
$be->names('bottom');
$c->createText($right/2,10, -text => $score, -tags => [ 'score' ],
    -fill => 'white');

my @missles;
# Missles go up and down here, are removed if offscreen
sub missles {
    my @di=();
    for(@missles) {
        ($t::x,$t::y)=$_->{sprite}->place;
        $t::y+=$alienmove*4*$_->{direction};
        $_->{sprite}->place($t::x,$t::y);
        if ($t::x<$left or $t::y<$top or
            $t::x>$right or $t::y>$bot) {
            $_->{sprite}->remove;
        } else {
            push(@di, $_);
        }
    }
    @missles=@di;
}

# My ship and Controls
my $ship=new Sprite($c);
$ship->image($img{"ship1.gif"});
$ship->names("me");
$ship->place(30,250);
$mw->bind('<Key>', [ sub {
    ($t::x,$t::y)=$ship->place;
    if ($_[1] == $Sprite::keycode::right) { $t::x2=$t::x+5; }
    elsif ($_[1] == $Sprite::keycode::left ) { $t::x2=$t::x-5; }
    elsif ($_[1] == $Sprite::keycode::fire ) {
        my $gun=new Sprite($c);
        $gun->image($img{"missle.gif"});
        $gun->names("missle","weapon");
        $gun->place($t::x, $t::y);
        push(@missles, {
            direction => -1,
            sprite => $gun,
            });
    }
    else { return; }
    $ship->place($t::x2,$t::y);
    if ( $ship->collide =~/right|left/) {
        $ship->place($t::x,$t::y);
    } }, Ev('k') ] );

# Enemies
my @badguys=();
my $direction=1;    # Pos is right
my $deathdelay=-3;  # How long splat is visible
my $startrow=50;
sub mkbadguys {
    @badguys=();
    $c->delete('alien');
    $c->delete('weapon');
    for my $t (1..2) {
        for my $i (1..9) {
            push(@badguys, { sprite=> new Sprite($c) });
            for($badguys[-1]) {
                $_->{sprite}->image($img{"alien.gif"});
                $_->{sprite}->place(25*$i, $startrow+$t*25);
                $_->{sprite}->names("alien$t$i","alien");
            }
        }
    }
    $startrow+=10;
}
sub maint {
    march();
    missles();
    $c->update;
    if ($ship->collide=~/bomb/ or $be->collide=~/alien/) {
        $ship->image($img{"splat.gif"},1);
        $c->createText(100,10,-text => "Game Over");
        $mw->bind('<Key>', undef);
    } elsif (!@badguys) {
        mkbadguys();
        $c->after(100, \&maint);
    } else {
        $c->after(100, \&maint);
    }
}
my $downrow;
sub march {
    my($collisions,$alive)=(0,0);
    for (@badguys) {
        delete $_->{oldloc};
        if ($_->{dead} && $_->{dead}<0 ) {
            if ($_->{dead} == $deathdelay) {
                $_->{sprite}->names("");
                $_->{sprite}->image($img{"splat.gif"},1);
                $_->{dead}++;
                $c->itemconfigure('score', -text => $score);
            }
            unless (++$_->{dead}) {
                $_->{sprite}->remove;
                $_->{dead}++;
            }
        }
        $alive++ unless $_->{dead};
    }
    @badguys=() unless $alive;
    for (@badguys) {
        next if $_->{dead};
        $_->{oldloc}=[ $_->{sprite}->place ];
        ($t::x, $t::y)=@{ $_->{oldloc} };
        $t::x+=$alienmove*$direction;
        $t::y+=$alienmove*4 if ($downrow);
        $_->{sprite}->place($t::x,$t::y);
        $a=$_->{sprite}->collide;
        if ($a=~/right|left/) {
            $collisions=1; last;
        }
        if ($a=~/missle/) {
            $_->{dead}=$deathdelay;
            $score+=10;
        }
        if (rand(1000)<5) {
            my $gun=new Sprite($c);
            $gun->image($img{"bomb.gif"});
            $gun->names("bomb","weapon");
            $gun->place($t::x, $t::y);
            push(@missles, { direction => 1, sprite => $gun, });
        }
    }
    $downrow=0;
    if ($collisions) {
        for(@badguys) {
            next if $_->{dead};
            next unless $_->{oldloc};
            $_->{sprite}->place(@{$_->{oldloc}});
        }
        $downrow=$direction*=-1;
    }
}
mkbadguys();
$c->after(100, \&maint);
$mw->MainLoop;

__END__
begin ship1.gif
R0lGODlhFAAUAPcAAAAAADH/796l9/echPf/GP8pEP////////////////////////////
+//////
N12N
/////////////////////////////////////////////////////ywAAAAAFAAUAAAIcw
+ABCBw4
0ADBgwgLCjCYsKEBARAZNjz4MOJEihAzSpxYcaHGiwAqGggg8qIBkSQjbsQYMaXFhB0Xns
+y4EGFM
mjhXdjz5kOdHhRYLEBBAoEDIn0drAhggtMAAgSWTbmT6FKjBngirEsR6EuTWlV7Dih0rMC
+AAOw==
begin alien.gif
R0lGODlhFAAUAPcAAAAAAADWEBiECKX37/9KGP//EP////////////////////////////
+//////
N12N
/////////////////////////////////////////////////////ywAAAAAFAAUAAAIfA
+ABCAQw
YMDAgwQNIiwoUOFBhQwHOiT4sCJCAQUzahwgAGFDAAIEEChAsgCBkBQfkiTAsqTJlgUmDn
+BJk6ZM
lwEKBMiZs+TEhCV79oz5U+JMm0U9bkzqMaHGpkoNMowINWNDiFQXPpTZNKvXoj+zpjS6MC
+xWs2I3
lr1aNiAAOw==
begin bomb.gif
R0lGODlhCgAKAPcAAAAAAP////////////////////////////////////////////////
+//////
N12N
/////////////////////////////////////////////////////ywAAAAACgAKAAAIJA
+ABAAgg
cGDBgwQPCkxoEKFBhg4VNpxYkCDEhgkvWpTIkGFAAAA7
begin missle.gif
R0lGODlhCgAKAPcAAAAAAKXn9/8pEP//GP////////////////////////////////////
+//////
N12N
/////////////////////////////////////////////////////ywAAAAACgAKAAAIMA
+ABCAQQ
IMDAgwYJHhSYMCFChgsLMnRosKHCghgzJhQwQABHAQc7euS4EMCAAQcDAgA7
begin splat.gif
R0lGODlhCgAKAPcAAAAAAOfvAP9CAP/GSv/nEP////////////////////////////////
+//////
N12N
/////////////////////////////////////////////////////ywAAAAACgAKAAAIQA
+ABCAxA
AMCAAAEAJBRgEEBBhRAFDJA4oCBCAgIkMnzocKLGiA4lWkw4oOJEAAwhJiQ4wKHAhwcRCp
+zZcqbA
gAAAOw==

Comment on Perl/Tk Space Invaders Game/Sprite Class
Download Code
Re: Perl/Tk Space Invaders Game/Sprite Class
by belg4mit (Prior) on Nov 13, 2001 at 01:24 UTC
    The name Sprite is currently used by a module which provides SQL abilities for a flatfile databse; it is quasi- deprecated by DBD::Sprite.

    Just in case you decide to release this...

    UPDATE: Added CPAN links, also seems the author of DBD::Sprite was inconsistent, his new version is JSprite though the DBI driver is not.

Re: Perl/Tk Space Invaders Game/Sprite Class
by clintp (Curate) on Nov 13, 2001 at 07:39 UTC
    To calm crazyinsomniac's fears about holding true to the Space Invader's memory. Here's the kind of patches you can add to the code. This one limits the number of onscreen shots for the player to 4 and adds new functionality: a callback mechanism for when missles get destroyed. (It's also a nice demonstration of a closure.)

    Inside of missles() add one line:

    if ($t::x<$left or $t::y<$top or $t::x>$right or $t::y>$bot) { &{$_->{callback}} if ($_->{callback}); #NEW $_->{sprite}->remove;
    There's the callback handler. And then change the anonymous subroutine that handles the ship controls to something like this:
    $mw->bind('<Key>', [ sub { my $curshot=0 if 0; # NEW # Later in that code block... elsif ($_[1] == $Sprite::keycode::fire ) { return if $curshot>3; #NEW $curshot++; #NEW my $gun=new Sprite($c); $gun->image($img{"missle.gif"}); $gun->names("missle","weapon"); $gun->place($t::x, $t::y); push(@missles, { direction => -1, callback => sub {$curshot--}, #NEW sprite => $gun, }); }
    And so in 5 lines we can control the number of shots fired by the hero. This can also be used to modify the number of shots fired by the aliens.

    And that's why this is a demo. It's for modifying and playing with, and only a framework.

Re: Perl/Tk Space Invaders Game/Sprite Class
by jynx (Priest) on Nov 18, 2001 at 04:36 UTC

    just a question,

    Where did you get the data for the gifs from? i've been searching around the web and haven't found anything that would give out such information willingly. i don't have excellent web-fu skills so if you could point me to some documentation or give an abstract that would help immensely.

    thanks for any help,
    jynx

      The gifs were hand drawn in GIMP and Paintshop. In order to use them with Tk as internal -data you have to base-64 encode them. As an added step I then put that N12N trick in to shorten them up a bit (otherwise there were lines and lines of identical text -- unused colormap entries).

      They're terrible little images. If I didn't mind copyright infractions I'd have F12's the real thing from xmame.

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://124912]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (5)
As of 2014-09-20 23:28 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (164 votes), past polls