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

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, 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


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

(c) Clinton Pierce 2001

Feel free to redistribute.  Enjoy!

=head1 EXAMPLE

    my $s=new Sprite();
    $s->name('spaceship', 'player1');
    if ($s->collide()=~/asteroid/) {
        $s->image($blowup, 1);

=over 4


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.



=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:

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



sub new {
    my($class, $canvas)=@_;
    my $self={ canvas => $canvas, id => "", names => []  };
    bless $self, $class;
sub names {
    return @{$self->{names}} unless (@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')
    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 {
        -tags => [ @{$self->{names}} ]);
sub place {
    my($self, $x, $y)=@_;
    if (! defined $x) {
    $self->{canvas}->coords($self->{id}, $x, $y);

sub collide {
    join ',', map
            { $_[0]->{canvas}->gettags($_) }

=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.


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
    * "mothership" hovering above for bonus points
    * animate the aliens.
    * missles should have some momentum after being 
          (this kills the other.)
    * missles should themselves blow up

Some less trivially (still fewer than 20 lines):

    * independant movement of aliens left/right,
    * "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.


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');
while(<DATA>) {
    if (/^begin\s(.*)/) { $f=$1; next; }
    if (/^N(\d+)N$/) {  $_.=("/"x78)x$1; } # Compression

# Left & right edges
my $le=new Sprite($c);
    -fill => 'black');
my $re=new Sprite($c);
    -fill => 'black');
my $be=new Sprite($c);
$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) {
        if ($t::x<$left or $t::y<$top or
            $t::x>$right or $t::y>$bot) {
        } else {
            push(@di, $_);

# My ship and Controls
my $ship=new Sprite($c);
$mw->bind('<Key>', [ sub {
    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->place($t::x, $t::y);
        push(@missles, {
            direction => -1,
            sprite => $gun,
    else { return; }
    if ( $ship->collide =~/right|left/) {
    } }, Ev('k') ] );

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

begin ship1.gif
begin alien.gif
begin bomb.gif
begin missle.gif
begin splat.gif
Replies are listed 'Best First'.
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 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 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,

      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.

Log In?

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

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (4)
As of 2020-09-30 00:41 GMT
Find Nodes?
    Voting Booth?
    If at first I donít succeed, I Ö

    Results (155 votes). Check out past polls.