15.3 Implementation

We will focus only on those routines that either are central to the game or illustrate Tk in action.

The main program simply consists of the two calls to init() and MainLoop(). init creates the screen, sets up the key bindings, and configures a timer to call tick. Let us jump into the meat of the action by starting with this procedure.

tick moves the block down and then reloads the timer, specifying itself as a callback:

sub tick {
    return if ($state == $PAUSED);
    if (!@block_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
}

fall() is called when the space bar is hit; it keeps moving the block down until it hits any tile in the heap or hits bottom. move_down returns a false when either of these happens.

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

move_down() simply adds $MAX_COLS to each of the block tile's cell positions to effectively move it one row down. It then checks whether any of these new positions touch the bottom of the grid or intersect with any preexisting heap tile's cell position. If so, it calls the merge_block_and_heap routine and returns a false value. If not, it simply remembers the set of new positions and uses the move method to move all the block tiles down in one fell swoop ($TILE_HEIGHT pixels down). It returns a 1 so that fall above knows to keep continuing.

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 (@block_cells) {
        if (($cell >= $first_cell_last_row) ||
            ($heap[$cell+$MAX_COLS])) {
            merge_block_and_heap();
            return 0;
        }
    }
    foreach  $cell (@block_cells) {
        $cell += $MAX_COLS;
    }
    $w_heap->move('block', 0,  $TILE_HEIGHT);
    return 1;
}

merge_block_and_heap does two major things: it hands over all of the block's tiles to the heap, and it nullifies %block. Then it marches through @heap looking for rows that have tiles in all columns. If it finds any, it marks all those tiles with an additional tag called delete, using the addtag method:

$w_canvas->addtag('delete', 'withtag' => $heap[$i]);

The straightforward way to delete a row would be to remove the corresponding entries in the heap and to delete the corresponding tiles on the canvas. But that method doesn't give the user an idea of which rows are being consolidated; besides, it's too boring. So merge_block_and_heap fills all the tiles tagged delete with a white background and, after 300 ms, deletes all these items. This way the user sees a full row change color to white for a brief instant before vanishing. Notice how the closure supplied to after makes it convenient to supply a piece of code to execute in the future. The same closure also moves the rest of the heap's tiles to their new places (because some rows have collapsed).

my $last_cell = $MAX_COLS * $MAX_ROWS;
sub merge_block_and_heap {
    my $cell;
    # merge block
    foreach $cell (@block_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;
        }
    }
    @block_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
                           }
                       });
    }
}

Let us now look at two of the other routines to manipulate the block: move_left and rotate. We'll skip move_right because it is similar to move_left.

move_left moves each of the block's tiles to the left by simply subtracting 1 from their respective cell positions. The function does nothing if any of the new positions go past the left edge or intersect with an occupied heap cell. If moving is allowed, the canvas items tagged "block" are simply moved $TILE_WIDTH pixels to the left:

sub move_left {
    my $cell;
    foreach $cell (@block_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 (@block_cells) {
        $cell--; # This affects the contents of @block_cells
    }
    
    $w_heap->move('block', - $TILE_WIDTH, 0);
}

rotate is a trifle more complex. It computes a pivot row and column from the block's tile positions and calculates new tile positions by a simple transformation explained in the following code. It also ensures that the newly computed positions are not illegal in any way (moving out of the grid or intersecting with the heap). It then calls the canvas's coords method to move each of the tiles individually to their new places.

sub rotate {
    # rotates the block counter_clockwise
    return if (!@block_cells);
    my $cell;
    # Calculate the pivot position around which to turn
    # The pivot is at (average x, average y) of all block_cells
    my $row_total = 0; my $col_total = 0;
    my ($row, $col);
    my @cols = map {$_ % $MAX_COLS} @block_cells;
    my @rows = map {int($_ / $MAX_COLS)} @block_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--;
    }
    @block_cells = @new_cells;
    1; # Success
}

When this mutant version of Tetris starts, it draws a small red triangular "gun" (cell number 70 in Figure 15.1). shoot is called when the "a" or "s" key is pressed. The "a" key shoots an arrow from the gun and blows off the leftmost tile of the block in the gun's row if the block happens to be passing by. The "s" key takes a shot at the rightmost tile. This is quite cheesy, really, but useful if you want to see how an animation sequence can be staged by using the canvas. The first part of the procedure simply determines which block tile is to be removed, if any. It then creates an arrow (a line with an arrowhead) from the gun to the selected tile, changes its stippling, and after a 200-ms interval, deletes both the tile and the arrow. This has the visual effect of blowing up a tile.

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' ? 
                $block_cells[$a] <=> $block_cells[$b] :
                    $block_cells[$b] <=> $block_cells[$a]
                    } (0 .. $#block_cells);
    my $found = -1;
    my $i;
    foreach $i (@indices) {
        $cell = $block_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 (@block_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); 
        });
    }
}

Let us now see the two routines responsible for setting up the screen: create_screen and bind_key. Both these functions are called by init(). Note the way the pack method is used in create_screen and how the space character is translated to an event-binding in bind_key.

sub create_screen {
    $w_top = MainWindow->new('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 {exit(0)}
                                );
    $w_heap->pack();
    $w_start->pack('-side'=> 'left', '-fill' => 'y', '-expand' => 'y');
    $w_quit->pack('-side'=> 'right', '-fill' => 'y', '-expand' => 'y');
}

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