view release on metacpan or  search on metacpan

bin/perltetris.pl  view on Meta::CPAN

    }
    $timer = Glib::Timeout->add(speed(), \&update);
    $canvas->{table}->clear;
    my $s = int(rand(scalar(@$shapes)));
    my $t = int(rand(scalar(@{$shapes->[$s]})));
    $next_shape = [$s, $t];
    new_shape();
}

sub show_heading {
    my $text = shift;
    if ( exists $canvas->{heading} && $canvas->{heading} ) {
        $canvas->{heading}->set(
            'text' => $text
        );
    }
    else {
        $canvas->{heading} =
            Goo::Canvas::Text->new(
                $canvas->get_root_item, $text, 50, 200, -1, 'nw',
                'font' => 'Sans Bold 24',
                'fill-color' => 'red'
            );
    }
}

sub remove_heading {
    if ( exists $canvas->{heading} && $canvas->{heading} ) {
        my $root = $canvas->get_root_item;
        $root->remove_child($root->find_child($canvas->{heading}));
        $canvas->{heading} = undef;
    }
}

sub new_shape {
    my $shape  = Tetris::Shape->new(
        -shape => $shapes->[$next_shape->[0]],
        -type => $next_shape->[1],
        -color => $Config{style}[$next_shape->[0] % @{$Config{style}}],
        -col => int($Config{cols}/2)-2,
        -table => $canvas->{table},
    );
    $shape->draw();
    $canvas->{shape} = $shape;
    # Draw preview
    my $s = int(rand(scalar(@$shapes)));
    my $t = int(rand(scalar(@{$shapes->[$s]})));
    $next_shape = [$s, $t];
    $canvas->{preview}->clear;
    $shape = Tetris::Shape->new(
        -shape => $shapes->[$s],
        -type => $t,
        -color => $Config{style}[$s  % @{$Config{style}}],
        -row => 1,
        -col => 1,
        -table => $canvas->{preview},
    );
    $shape->draw();
}

sub update {
    # print "update $timer_pause\n";
    return TRUE if $timer_pause;
    my $shape  = $canvas->{shape};
    my $hit = $shape->move_down;
    if ( $hit ) {
        done();
    }
    return TRUE;
}

sub done {
    my $shape = $canvas->{shape};
    my $table = $canvas->{table};
    my %row = map { $_->[0] => 1 } @{$shape->cells};
    my $ln = $table->eliminate_line_maybe( keys %row );
    score($ln);
    if ( $table->is_full ) {
        game_over();
    }
    else {
        new_shape();
    }
}

sub score {
    my $ln = shift || 0;
    my $oldscore = $score;
    my @score = ( 0, 10, 20, 40, 60 );
    # my @score = ( 0, 20, 40, 70, 100 );    
    $score += $score[$ln];
    $lines += $ln;

    if ( int($score/100) > int($oldscore/100) ) {
        # print "levelup $level at $score\n";
        $level++;
        $level = $level % 11;   # level: 0-10
        Glib::Source->remove($timer);
        $timer = Glib::Timeout->add(speed(), \&update);
    }
    update_label();
}

sub update_label {
    my $labels = $canvas->{labels};
    $labels->[0]->set_label( make_string("Scores", $score));
    $labels->[1]->set_label( make_string("Lines", $lines));
    $labels->[2]->set_label( make_string("Level", $level));
}

sub speed {
    return int(500/($level*0.5+1));
}

sub rank_dia {
    my $score = shift;
    my ($idx, $new_iter, $new_entry);
    my $max = $Config{max_rank_list}-1;
    if ( defined $score ) {
        if ( !defined $history ) {
            $history = [ $new_entry ];
            $idx = 0;
        } else {
            $new_entry = [$Config{name} || getlogin || getpwuid($<) || 'Nobody', $score];
            $history = [ sort {$b->[1] <=> $a->[1]} @$history ];
            $idx = 0;
            while ( $idx <= $#$history ) {
                last if $score >= $history->[$idx][1];
                $idx++;
            }
            if ( $idx > $max && $idx > $#$history ) {
                return;
            } else {
                splice(@$history, $idx, 0, $new_entry);
                if ( $#$history > $max ) {
                    $#$history = $max;
                }
            }
        }
    }
    if ( @$history == 0 ) {
        my $dia = Gtk2::MessageDialog->new(
            $window, 'destroy-with-parent',
            'info',
            'ok',
            "No rank list yet!",
        );
        $dia->run;
        $dia->destroy;
        return FALSE;
    }
    my $dia = Gtk2::Dialog->new(
        'Rank', $window,
        ['modal', 'destroy-with-parent'],
        'gtk-ok' => 'ok',
    );
    my $vbox = $dia->vbox;
    my $store = Gtk2::ListStore->new( qw/Glib::String Glib::Int/ );
    foreach ( 0..$#$history ) {
        my $iter = $store->append();
        $store->set($iter,
                    0, $history->[$_][0],
                    1, $history->[$_][1],
                );