perl 的人气太差。罢了罢了。找本perl自己搞定

[dust]

[阿鹏兄]

是呀。

[milson]

要是有这样一本好书，我也不来这里了。

[netken]

既然我们都在perl版里，为什么不想想怎样提高这里的人气？
不要总是把perl局限在一个cgi的小圈子中啊，
要知道perl的功能强大的很
（以上不针对任何人)

[iamxxg]

是呀，谁讲讲TK呀，我想知道

[netken]

最好的办法就是看man,hoho
也可以看看learning tk,我这里有几个自己用perl tk写的小游戏，若赶兴趣的话
我可以贴上来

[netken]

先放个扫雷，hoho

#!/usr/bin/perl
# NetKen.

use Tk;

$max = 15;#line number
$bomb = 20;#Bomb! number

$win = MainWindow->new( "-title"=>"Perl/Tk 扫雷!" );

startbutton();
label();

MainLoop();

sub startbutton {
$start_room = $win->Frame()->pack( '-side'=>'top' );
$start_button = $start_room->Button ( "-text"=>"START" , "-width"=>$max , "-height"=>1 , "-font"=>"-adobe-helvetica-bold-b-narrow--18-180-80-80-p-80-iso8859" , "-foreground"=>"red" , "-command"=>\&start )->pack ( "-side"=>"top" );
};

sub start {
$start_button->destroy();
format_array();
level();
};

sub restart {
for (my $i=0;$i<$max ;$i++)
{
my $n_i = "$i";$n_i = "0$i" if $i<10;
my $button_room_name = "button_room"."$i";
${$button_room_name}->destroy();
for (my $j=0;$j<$max ;$j++) {
my $n_j = "$j";$n_j = "0$j" if $j<10;
my $button_name = "button".$n_i.$n_j;
undef ${$button_name};
}
}

$start_button->configure ( "-text"=>"START" , "-command"=> \&start );
};

sub label {
$label = $win->Label ( "-text"=>"Kick Bomb! - START!" , "-width"=>($max-1)*2 , "-height"=>2 , "-font"=>"-adobe-verdana-bold-r-narrow--18-180-80-80-p-80-iso8859")->pack( "-side"=>"top" );
};

sub format_array {
undef @array;
for (my $k=0;$k<$bomb+1 ;$k++) {
srand(rand($max*100));
my $number = rand($max*100);
$number=int($number);
$number+=$max if $number<$max;
my $i = $number % $max;
my $j = int(( $number - $j ) / $max);
$array[$i][$j] = "0";
}
for (my $i=0;$i<$max ;$i++ ) {
for (my $j=0;$j<$max ;$j++ ) {
if ($array[$i][$j] eq "0") {
$array[$i-1][$j]++ if $i>0 and $array[$i-1][$j] ne "0";
$array[$i+1][$j]++ if $i<$max-1 and $array[$i+1][$j] ne "0";
$array[$i][$j-1]++ if $j>0 and $array[$i][$j-1] ne "0";
$array[$i][$j+1]++ if $j<$max-1 and $array[$i][$j+1] ne "0";
$array[$i-1][$j-1]++ if $i>0 and $j>0 and $array[$i-1][$j-1] ne "0";
$array[$i+1][$j+1]++ if $i<$max-1 and $j<$max-1 and $array[$i+1][$j+1] ne "0";
$array[$i-1][$j+1]++ if $i>0 and $j<$max-1 and $array[$i-1][$j+1] ne "0";
$array[$i+1][$j-1]++ if $i<$max-1 and $j>0 and $array[$i+1][$j-1] ne "0";
}
}
}
};

sub level {
for (my $i=0;$i<$max ;$i++)
{
my $n_i = "$i";$n_i = "0$i" if $i<10;
my $button_room_name = "button_room"."$i";
$eval .= '$'."$button_room_name".'=$win->Frame()->pack("-side"=>"top");';
for (my $j=0;$j<$max ;$j++) {
my $n_j = "$j";$n_j = "0$j" if $j<10;
my $button_name = "button".$n_i.$n_j;
$eval .= '$'."$button_name".'=$'."$button_room_name".'->Button("-text"=>"?","-width"=>1,"-height"=>1,"-command"=>[\&change_button,'."$i,$j".'])->pack("-side"=>"left");';
}
}
eval $eval;
undef $eval;
};

# 如果为 null ,则 flat ,如果有数字 则 ridge
sub change_button {
my $i = shift;
my $j = shift;
my $n_i = "$i";$n_i = "0$i" if $i<10;
my $n_j = "$j";$n_j = "0$j" if $j<10;
if ($array[$i][$j] eq "0") {
gameover();
} else {
unless ($array[$i][$j]) {
disp_blank($i,$j);
} else {
${"button".$n_i.$n_j}->configure ( "-text"=>"$array[$i][$j]" , "-relief"=>"ridge" );
}
}
};

sub disp_blank {
my $i = shift;
my $j = shift;

my $m_i = "$i";$m_i = "0$i" if $i<10;
my $m_j = "$j";$m_j = "0$j" if $j<10;

${"button".$m_i.$m_j}->configure ( "-text"=>"$array[$i][$j]" , "-relief"=>"flat" );

if ($i>0 and $array[$i-1][$j] eq "" ) {
my $num_i = $i-1;
my $n_i = "$num_i";$n_i = "0$num_i" if $num_i<10;
my $n_j = "$j";$n_j = "0$j" if $j<10;
my $state = ${"button".$n_i.$n_j}->cget ( "-relief" );
disp_blank($i-1,$j) unless $state eq "flat";
}
if ( $j>0 and $array[$i][$j-1] eq "" ) {
my $num_j = $j-1;
my $n_i = "$i";$n_i = "0$i" if $i<10;
my $n_j = "$num_j";$n_j = "0$num_j" if $num_j<10;
my $state = ${"button".$n_i.$n_j}->cget ( "-relief" );
disp_blank($i,$j-1) unless $state eq "flat";
}
if ( $i<$max-1 and $array[$i+1][$j] eq "" ) {
my $num_i = $i+1;
my $n_i = "$num_i";$n_i = "0$num_i" if $num_i<10;
my $n_j = "$j";$n_j = "0$j" if $j<10;
my $state = ${"button".$n_i.$n_j}->cget ( "-relief" );
disp_blank($i+1,$j) unless $state eq "flat";
}
if ( $j<$max-1 and $array[$i][$j+1] eq "" ) {
my $num_j = $j+1;
my $n_i = "$i";$n_i = "0$i" if $i<10;
my $n_j = "$num_j";$n_j = "0$num_j" if $num_j<10;
my $state = ${"button".$n_i.$n_j}->cget ( "-relief" );
disp_blank($i,$j+1) unless $state eq "flat";
}


};

sub gameover {
for (my $i=0;$i<$max ;$i++ ) {
for (my $j=0;$j<$max ;$j++ ) {
my $n_i = "$i";$n_i = "0$i" if $i<10;
my $n_j = "$j";$n_j = "0$j" if $j<10;
${"button".$n_i.$n_j}->configure ( "-text"=>"X" , "-foreground"=>"red" , "-background"=>"black" ) if $array[$i][$j] eq "0";
}
}
$start_button = $start_room->Button ( "-text"=>"RESTART" , "-width"=>$max , "-height"=>1 , "-font"=>"-adobe-helvetica-bold-b-narrow--18-180-80-80-p-80-iso8859" , "-foreground"=>"red" , "-command"=>\&restart )->pack ( "-side"=>"top" );
$label->configure ( "-text"=>"Bomb... Oh~ u r FAILED!" );
};

[isaxu]

对呀，人气差要我们共同来努力呀！
我是刚刚注册进来的，看到有perl一块地盘高兴的不得了

[111222]

有tk游戏的演示么？我感兴趣！