Games::Tetris - representation of a tetris game state

Games-Tetris documentation Contained in the Games-Tetris distribution.

Index

Code Index:

NAME

Top

Games::Tetris - representation of a tetris game state

SYNOPSIS

Top

 use Games::Tetris;
 my $well = Games::Tetris->new;
 my $ess = $well->new_shape(' +',
                            '++',
                            '+ ');
 $well->drop( $ess, 3, 1 );
 $well->print;

DESCRIPTION

Top

This module can be used as the rules engine for the game of tetris. It allows you to create a well and drop pieces in it. The well tracks the status its contents and handles completed line removal.

METHODS

Top

new

Creates a new gamestate

Takes the following optional parameters:

well an initial well, an array of arrays. use undef to indicate an empty cell, any other value is considered occupied

or

width, depth dimensions of a new well (defaults to 15 x 20)

new_shape

delegates to Games::Tetris::Shape->new

print

used by the testsuite. prrints the current state of the well

->fits( $shape, $x, $y )

returns a true value if the given shape would fit in the well at the location $x, $y

->drop( $shape, $x, $y )

returns false if the shape will not fit at the location indicated by $x, $y

if the shape can be dropped it will be advanced to the bottom of the well and the return value will be the rows removed by the dropping operation, if any, as an array reference

TODO

Top

$shape->rotate
Tk/Qt/Wx interface
Network Code
Watch all tuits go bye bye

AUTHOR

Top

Richard Clamp <richardc@unixbeard.net>

COPYRIGHT

Top

Copyright (C) 2003 Richard Clamp. All Rights Reserved.

This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

SEE ALSO

Top

Games::Tetris::Shape

Games-Tetris documentation Contained in the Games-Tetris distribution. 
package Games::Tetris;
use strict;
use Games::Tetris::Shape;
our $VERSION = '0.01';


sub new {
    my $referent = shift;
    my %args = @_;
    my $class = ref $referent || $referent;

    my $self = bless {}, $class;

    my ($w, $d) = delete @args{ qw{ width depth } };
    if ($self->{_well} = delete $args{well}) {
        # figure out width and depth
        die "I be slack";
    }
    else {
        # make a new well
        $self->{_width} = $w || 15;
        $self->{_depth} = $d || 20;

        $self->{_well} = [ map {
            [ (undef) x $self->width ]
        } 1 .. $self->depth ];
    }

    die "leftover arguments:". join (', ', map {"'$_'"} keys %args)
      if keys %args;
    return $self;
}

sub width { $_[0]->{_width} }
sub depth { $_[0]->{_depth} }
sub well  { $_[0]->{_well} }


sub new_shape {
    my $self = shift;
    Games::Tetris::Shape->new(@_);
}


sub print {
    my $self = shift;
    print "# /", ('-') x $self->width, "\\\n";
    print "# |", join( '', map { $_ ? $_ : ' ' } @$_ ), "|\n"
      for @{ $self->well };
    print "# \\", ('-') x $self->width, "/\n";
}


sub fits {
    my $self = shift;
    my ($shape, $at_x, $at_y) = @_;

    for ($shape->covers($at_x, $at_y)) {
        my ($x, $y) = @$_;
        return if ($x < 0 ||
                   $y < 0 ||
                   $x >= $self->width ||
                   $y >= $self->depth ||
                   $self->well->[ $y ][ $x ]);
    }
    return 1;
}


sub drop {
    my $self = shift;
    my ($shape, $at_x, $at_y) = @_;

    return unless $self->fits(@_);
    my $max_y = $at_y;
    for (my $y = $at_y; $y <= $self->depth; $y++) {
        last if !$self->fits( $shape, $at_x, $y );
        $max_y = $y;
    }
    for ($shape->covers($at_x, $max_y)) {
        my ($x, $y, $val) = @$_;
        $self->well->[ $y ][ $x ] = $val;
    }

    my @removed;
    for (my $y = 0; $y < $self->depth; $y++) {
        my $inrow = grep { $_ } @{ $self->well->[$y] };
        next if $inrow != $self->width;
        push @removed, $y;
    }

    splice @{ $self->well }, $_, 1
      for reverse @removed;
    unshift @{ $self->well }, [(undef) x $self->width]
      for @removed;
    return \@removed;
}

1;

__END__