tetris.pl

perl learn perl by examples

###############################################################################
# tetris.pl - tetris using Perl and Tk
#                     ... Sriram
################################################################################

use strict;
use Tk;
my $MAX_COLS         = 10 ;       # 10 cells wide
my $MAX_ROWS         = 15 ;       # 15 cells high
my $TILE_WIDTH       = 20;        # width of each tile in pixels 
my $TILE_HEIGHT      = 20;        # height of each tile in pixels 

my $shoot_row        = int($MAX_ROWS/2);
my @cells = ();
my @tile_ids = ();

# Widgets
my $w_start;                              # start button widget
my $w_top;                                # top level widget
my $w_heap;                               # canvas

my $interval = 500; # in milliseconds
my @heap = ();                            # An element of the heap contains
                                          # a tile-id if that cell is
                                          # filled
$heap[$MAX_COLS * $MAX_ROWS - 1] = undef; # presize
# States
my $START = 0;
my $PAUSED = 1;
my $RUNNING = 2;
my $GAMEOVER = 4;
my $state = $PAUSED;

#----------------------------------------------------------------
# Block manipulation 
#----------------------------------------------------------------
sub tick {
    return if ($state == $PAUSED);

    if (!@cells) {
        if (!create_random_block()) {
            game_over();              # Heap is full:could not place block
            return;                   # at next tick interval
        }
        $w_top->after($interval, \&tick);
        return;
    }
    move_down();                      # move the block down
    $w_top->after($interval, \&tick); # reload timer for nex

}

sub fall {                 # Called when spacebar hit
    return if (!@cells);   # Return if not initialized
    1 while (move_down()); # Move down until it hits the heap or bottom.
}

sub move_left {
    my $cell;
    foreach $cell (@cells) {
        # Check if cell is at the left edge already
        # If not, check whether the cell to its left is already occupied.
        if ((($cell % $MAX_COLS) == 0) ||
            ($heap[$cell-1])){
            return;
        }
    }

    foreach $cell (@cells) {
        $cell--; # This affects the contents of @cells
    }
    
    $w_heap->move('block', - $TILE_WIDTH, 0);
}


sub move_right {
    my $cell;
    
    foreach $cell (@cells) {
        # Check if cell is at the right edge already
        # If not, check whether the cell to its right is already occupied.
        if (((($cell+1) % $MAX_COLS) == 0) ||
            ($heap[$cell+1])){
            return;
        }
    }

    foreach $cell (@cells) {
        $cell++; # This affects the contents of @cells
    }
    
    $w_heap->move('block', $TILE_WIDTH, 0);
}

sub move_down {
    my $cell;

    my $first_cell_last_row = ($MAX_ROWS-1)*$MAX_COLS;
    # if already at the bottom of the heap, or if a move down
    # intersects with the heap, then merge both.
    foreach $cell (@cells) {
        if (($cell >= $first_cell_last_row) ||
            ($heap[$cell+$MAX_COLS])) {
            merge_block_and_heap();
            return 0;
        }
    }

    foreach  $cell (@cells) {
        $cell += $MAX_COLS;
    }

    $w_heap->move('block', 0,  $TILE_HEIGHT);

    return 1;
}

sub rotate {
    # rotates the block counter_clockwise
    return if (!@cells);
    my $cell;
    # Calculate the pivot position around which to turn
    # The pivot is at (average x, average y) of all cells
    my $row_total = 0; my $col_total = 0;
    my ($row, $col);
    my @cols = map {$_ % $MAX_COLS} @cells;
    my @rows = map {int($_ / $MAX_COLS)} @cells;
    foreach (0 .. $#cols) {
        $row_total += $rows[$_];
        $col_total += $cols[$_];
    }
    my $pivot_row = int ($row_total / @cols + 0.5); # pivot row
    my $pivot_col = int ($col_total / @cols + 0.5); # pivot col
    # To position each cell counter_clockwise, we need to do a small
    # transformation. A row offset from the pivot becomes an equivalent 
    # column offset, and a column offset becomes a negative row offset.
    my @new_cells = ();
    my @new_rows = ();
    my @new_cols = ();
    my ($new_row, $new_col);
    while (@rows) {
        $row = shift @rows;
        $col = shift @cols;
        # Calculate new $row and $col
        $new_col = $pivot_col + ($row - $pivot_row);
        $new_row = $pivot_row - ($col - $pivot_col);
        $cell = $new_row * $MAX_COLS + $new_col;
        # Check if the new row and col are invalid (is outside or something
        # is already occupying that  cell)
        # If valid, then no-one should be occupying it.
        if (($new_row < 0) || ($new_row > $MAX_ROWS) ||
            ($new_col < 0) || ($new_col > $MAX_COLS)  ||
            $heap[$cell]) {
            return 0;
        }
        push (@new_rows, $new_row);
        push (@new_cols, $new_col);
        push (@new_cells, $cell);
    }
    # Move the UI tiles to the appropriate coordinates
    my $i= @new_rows-1;
    while ($i >= 0) {
        $new_row = $new_rows[$i];
        $new_col = $new_cols[$i];
        $w_heap->coords($tile_ids[$i],
                        $new_col * $TILE_WIDTH,      #x0
                        $new_row * $TILE_HEIGHT,     #y0
                        ($new_col+1) * $TILE_WIDTH,  #x1
                        ($new_row+1) * $TILE_HEIGHT);
        $i--;
    }
    @cells = @new_cells;
    1; # Success
}


sub set_state {
    $state = $_[0];
    if ($state == $PAUSED) {
        $w_start->configure ('-text' => 'Resume');
    } elsif ($state == $RUNNING) {
        $w_start->configure ('-text' => 'Pause');
    } elsif ($state == $GAMEOVER) {
        $w_heap->itemconfigure ('all',
                                '-stipple' => 'gray25');
        $w_heap->create ('text',
                         $MAX_COLS  * $TILE_WIDTH  /2 ,
                         $MAX_ROWS * $TILE_HEIGHT /2 ,
                         '-anchor' => 'center',
                         '-text' => "Game\nOver",
                         '-width' => $MAX_COLS * $TILE_WIDTH);
        $w_start->configure ('-text' => 'Start');
    } elsif ($state == $START) {
        $w_start->configure ('-text' => 'Start');
    }
}
sub start_pause {
    if ($state == $RUNNING) {
        set_state($PAUSED);
    } else {
        if ($state == $GAMEOVER) {
            new_game();
        }
        set_state($RUNNING);
        tick();
    }
}

sub new_game() {
    $w_heap->delete('all');
    @heap = ();
    @cells = ();
    my $y = ($shoot_row + 0.5)*$TILE_HEIGHT;
    my $arrow_width = $TILE_WIDTH/2;
    $w_heap->create('line',
                    0,
                    $y,
                    $arrow_width,
                    $y,
                    '-fill' => 'red',
                    '-arrow' => 'last',
                    '-arrowshape' => [$arrow_width,$arrow_width,$arrow_width/2]
                    );
    show_heap();
}

sub bind_key {
    my ($keychar, $callback) = @_;
    if ($keychar eq ' ') {
        $keychar = "KeyPress-space";
    }
    $w_top->bind("<${keychar}>", $callback);
}




sub shoot {
    my ($dir) = @_;
    my $first_cell_shoot_row = $shoot_row*$MAX_COLS;
    my $last_cell_shoot_row = $first_cell_shoot_row + $MAX_COLS;
    my $cell;
    my (@indices) = 
        sort {
            $dir eq 'left' ? 
                $cells[$a] <=> $cells[$b] :
                    $cells[$b] <=> $cells[$a]
                    } (0 .. $#cells);

    my $found = -1;