tetris.pl

perl learn perl by examples

    my $i;
    foreach $i (@indices) {
        $cell = $cells[$i];
        if (($cell >= $first_cell_shoot_row) &&
            ($cell < $last_cell_shoot_row)) {
            $found = $i;
            last;
        }
    }
    if ($found != -1) {
        my $shot_tile = $tile_ids[$found];
        ($cell) = splice (@cells, $found, 1);
        splice (@tile_ids, $found, 1);
        my $y = ($shoot_row + 0.5)*$TILE_HEIGHT;
        my $arrow = $w_heap->create(
                                    'line',
                                    0,
                                    $y,
                                    (($cell % $MAX_COLS) + 0.5) * $TILE_WIDTH,
                                    $y,
                                    '-fill' => 'white',
                                    '-arrow' => 'last',
                                    '-arrowshape' => [7,7,3]
                                    );
        
        $w_heap->itemconfigure($shot_tile,
                               '-stipple' => 'gray25');
        $w_top->after (200,sub {
            $w_heap->delete($shot_tile); 
            $w_heap->delete($arrow); 
        });
    }

}


sub merge_block_and_heap {
    my $cell;
    # merge block
    foreach $cell (@cells) {
        $heap[$cell] = shift @tile_ids;
    }
    $w_heap->dtag('block'); # Forget about the block - it is now merged 

    # check for full rows, and get rid of them
    # All rows above them need to be moved down, both in @heap and 
    # the canvas, $w_heap
    my $last_cell = $MAX_ROWS * $MAX_COLS;

    my $filled_cell_count;
    my $rows_to_be_deleted = 0;
    my $i;

    for ($cell = 0; $cell < $last_cell; ) {
        $filled_cell_count = 0;
        my $first_cell_in_row = $cell;
        for ($i = 0; $i < $MAX_COLS; $i++) {
            $filled_cell_count++ if ($heap[$cell++]);
        }
        if ($filled_cell_count == $MAX_COLS) {
            # this row is full
            for ($i = $first_cell_in_row; $i < $cell; $i++) {
                $w_heap->addtag('delete', 'withtag' => $heap[$i]);
            }
            splice(@heap, $first_cell_in_row, $MAX_COLS);
            unshift (@heap, (undef) x $MAX_COLS);
            $rows_to_be_deleted = 1;
        }
    }

    @cells = ();
    @tile_ids = ();
    if ($rows_to_be_deleted) {
        $w_heap->itemconfigure('delete', 
                               '-fill'=> 'white');
        $w_top->after (300, 
                       sub {
                           $w_heap->delete('delete');
                           my ($i);
                           my $last = $MAX_COLS * $MAX_ROWS;
                           for ($i = 0; $i < $last; $i++) {
                               next if !$heap[$i];
                               # get where they are
                               my $col = $i % $MAX_COLS;
                               my $row = int($i / $MAX_COLS);
                               $w_heap->coords(
                                    $heap[$i],
                                    $col * $TILE_WIDTH,       #x0
                                    $row * $TILE_HEIGHT,      #y0
                                    ($col+1) * $TILE_WIDTH,   #x1
                                    ($row+1) * $TILE_HEIGHT); #y1

                           }
                       });
    }
}

sub show_heap {
    my $i;
    foreach $i (1 .. $MAX_ROWS) {
        $w_heap->create('line',
                        0,
                        $i*$TILE_HEIGHT,
                        $MAX_COLS*$TILE_WIDTH,
                        $i*$TILE_HEIGHT,
                        '-fill' => 'white'
                        );
    }
    foreach $i (1 .. $MAX_COLS) {
        $w_heap->create('line',
                        $i*$TILE_WIDTH,
                        0,
                        $i*$TILE_WIDTH,
                        $MAX_ROWS * $TILE_HEIGHT,
                        '-fill' => 'white'
                        );
    }

}

my @patterns = (
                [
                 "*  ",
                 "***"
                 ],
                [
                 "***",
                 "* *"
                 ],
                [
                 " * ",
                 "***"
                 ],
                [
                 "****"
                 ],
                [
                 "  *",
                 "***"
                 ],
                [
                 "*  ",
                 "***"
                 ],
                [
                 " **",
                 "** "
                 ],
                [
                 "**",
                 "**"
                 ]
                );
my @colors = (
              '#FF0000', '#00FF00', '#0000FF', 
              '#FFFF00', '#FF00FF', '#00FFFF'
              );


sub game_over {
    set_state($GAMEOVER);
}

sub create_random_block {
    # choose a random pattern, a random color, and position the 
    # block at the top of the heap.
    my $pattern_index = int(rand (scalar(@patterns)));
    my $color   = $colors[int(rand (scalar (@colors)))];
    my $pattern = $patterns[$pattern_index];
    my $pattern_width = length($pattern->[0]);
    my $pattern_height = scalar(@{$pattern});
    my $row = 0;  my $col = 0;
    my $base_col = int(($MAX_COLS - $pattern_width) / 2);
    while (1) {
        if ($col == $pattern_width) {
            $row++; $col = 0;
        }
        last if ($row == $pattern_height);
        if (substr($pattern->[$row], $col, 1) ne ' ') {
            push (@cells, $row * $MAX_COLS + $col + $base_col);
        }
        $col++;
    }
    $col = 0;
    my $cell;
    foreach $cell (@cells) {
        # If something already exists where the block is supposed
        # to be, return false
        return 0 if ($heap[$cell]);
    }

    $col = 0;
    foreach $cell (@cells) {
        create_tile($cell, $color);
    }
    return 1;
}

sub create_tile {
    my ($cell, $color) = @_;
    my ($row, $col);
    $col = $cell % $MAX_COLS;
    $row = int($cell / $MAX_COLS);
    push (@tile_ids, 
          $w_heap->create('rectangle',
                          $col * $TILE_WIDTH,      #x0
                          $row * $TILE_HEIGHT,     #y0
                          ($col+1) * $TILE_WIDTH,  #x1
                          ($row+1) * $TILE_HEIGHT, #y1
                          '-fill' => $color,
                          '-tags' => 'block'
                          )
          );
}

sub init {
    create_screen();
    bind_key('j', \&move_left);
    bind_key('l', \&move_right);
    bind_key(' ', \&fall);
    bind_key('k', \&rotate);
    bind_key('a', sub {shoot('left')});
    bind_key('s', sub {shoot('right')});
    srand();
    set_state($START);
    new_game();
}

sub create_screen {
    $w_top = MainWindow->new(-title =>'Tetris - Perl/Tk');

    $w_heap = $w_top->Canvas('-width'  => $MAX_COLS * $TILE_WIDTH,
                             '-height' => $MAX_ROWS  * $TILE_HEIGHT,
                             '-border' => 1,
                             '-relief' => 'ridge');
    $w_start = $w_top->Button('-text' => 'Start',
                              '-command' => \&start_pause,
                              );
    my $w_quit = $w_top->Button('-text' => 'Quit',
#               '-command' => sub {$w_top->withdraw();exit(0)}
                                '-command' => sub {exit(0)}
                                );
    $w_heap->pack();
    $w_start->pack('-side'=> 'left', '-fill' => 'y', '-expand' => 'y');
    $w_quit->pack('-side'=> 'right', '-fill' => 'y', '-expand' => 'y');
}

init();
MainLoop();