view release on metacpan or  search on metacpan

bin/perltetris.pl  view on Meta::CPAN

    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],
                );
        if ( defined $idx && $idx == $_ ) {
            $new_iter  = $iter;
        }
    }
    my $treeview = Gtk2::TreeView->new($store);
    my $col = Gtk2::TreeViewColumn->new();
    $col->set_title('name');
    my $ren = Gtk2::CellRendererText->new;
    if ( defined $score ) {
        $ren->set_property('editable' => TRUE);
        $ren->{'renderer_number'} = 0;
        $ren->signal_connect(
            edited => sub {
                my ($cell, $path_string, $new_text) = @_;
                $new_entry->[0] = $new_text;
                $store->set($new_iter, 0, $new_text);
                $cell->set_property('editable' => FALSE);
                return FALSE;
            }
        );