Perl看完这个,再不敢说自己会玩贪吃蛇

use strict;
use 5.01;
use Time::HiRes qw/sleep/;
use Term::ReadKey;
use constant {WIDTH=>12,HEIGHT=>8,DEBUG=>0};
my @bg=();
my @snake=();
my @head2food=();
my @food_coordinate=();  # 保存食物坐标
my ($score,$food,$speed,$alive,$head2tail,$head_move)=(0,0,1,1,0,4); # 得分、食物、速度、存活、能否回到尾巴的标志、初始移动方向
my $full=(WIDTH-2)*(HEIGHT-2);
my %opposite=( 1=>3,
2=>4,
3=>1,
4=>2, );  # 对立的移动方向，禁止反向移动
my @uldr=( 0,[-1,0],[0,-1],[1,0],[0,1], ); # 上、左、下、右
############################################################################################
&init;
#my $move=&manual_move(4);  # 开始向右移动
my $move=&smart_move($head_move);$speed=9;
while( $alive && @snake < $full ){
@head2food=&head_to_food($head_move,@snake);  # 计算蛇头到食物的路径
if( $head2food[0] != 0 ){                      # 有路径
$head2tail=&head_to_tail(\@snake,\@head2food);    # 判断吃到食物后是否能回到尾巴
if($head2tail){        # 能回到尾巴，吃食物
foreach( @head2food ){
$head_move=$_;
$move->($head_move);
&check_head;
if($alive){
&show;
sleep (1-$speed*0.1);
}
}
}
}
$head_move=&trace_tail($head_move,@snake);        # 找出当前可行方向追逐蛇尾
$move->($head_move);
&check_head;
if($alive){
&show;
sleep (1-$speed*0.1);
}
}
if(@snake==$full){
print "\ncongratulations!\n";  # 蛇占满游戏区时显示
}
else{
print "\nWTF?\n";
}
############################################################################################
sub init{
my $y=int(HEIGHT/2);
for(my $y=0;$y<HEIGHT;$y++){
for( my $x=0 ; $x<WIDTH ; $x++ ){
if( $y == 0 || $y == HEIGHT-1 ||
$x == 0 || $x == WIDTH-1  ){
$bg[$y][$x] = '*';
}
else{
$bg[$y][$x] = ' ';
}
}
}
@{$bg[$y]}[1,2]=('#','@'); # 初始蛇身位置
@snake=( [$y,2],[$y,1], ); # 保存蛇身坐标
&make_food;  # 产生食物
}
############################################################################################
sub show{
system("cls") unless(DEBUG);
print "your score : $score\n";
print "current speed : ",$speed,"\n\n";
print @$_,"\n" foreach(@bg);
}
############################################################################################
sub smart_move{
my $move_direct=shift;
sub{  # 闭包，传入初始移动方向
$move_direct=shift;
unshift @snake,[$snake[0][0]+$uldr[$move_direct][0],$snake[0][1]+$uldr[$move_direct][1]];
}
}
############################################################################################
sub head_to_food{  # 蛇头到食物
my $head_shadow=shift;
my @snake_ghost=@_;
my @bg_ghost=@bg;
my @path=&a_star( [ $snake_ghost[0][0],$snake_ghost[0][1] ],
[ $food_coordinate[0],$food_coordinate[1] ],\@bg_ghost ); # A*算法，传递起点、终点、蛇当前坐标指针
return @path;
}
############################################################################################
# 追逐尾巴,传递当前移动方向、蛇身所有坐标
sub trace_tail{
print "call trace_tail\n" if DEBUG;
my $cur_move=shift;  # 当前移动方向
my @snake_ghost=@_;
my @path=();
my $cur_position=[ $snake_ghost[0][0],$snake_ghost[0][1] ];  # 起点
print "    cur_position:",$snake_ghost[0][0],",",$snake_ghost[0][1],"\n" if DEBUG;
my $end=[ $snake_ghost[-1][0],$snake_ghost[-1][1] ];  # 终点
my $tail=$#snake_ghost;  # 蛇长度

my @bg_ghost=map{ [ split('','0'x WIDTH) ] }0..(HEIGHT-1);  # 0--未经过 1--已走 2--不可通过
map{ my $y=$_;map { $bg_ghost[$y][$_] = ( $bg[$y][$_] eq '*' )?2:0 }0..$#{$bg[0]} }0..$#bg;
map{ $bg_ghost[ $snake_ghost[$_][0] ][ $snake_ghost[$_][1] ] = 2 } 1..$#snake_ghost;  # 蛇身不可通过
my @feasible=();
my @next_moves=grep{ ! /$opposite{$cur_move}/ }values %opposite;  # 取出除反方向的可行方向
my $weight=0;
foreach(@next_moves){
$weight=1;
my $next_move=$_;
my ($y,$x)=( $snake_ghost[0][0]+$uldr[$next_move][0],$snake_ghost[0][1]+$uldr[$next_move][1] );
# 防止越界
if( $y < 1 || $y > HEIGHT-2 || $x < 1 || $x > WIDTH-2){
$weight=0;
next;
}

# 防止吃到自己
foreach(0..$#snake_ghost){
if( $y == $snake_ghost[$_][0] && $x == $snake_ghost[$_][1]  ){
$weight=0;
last;
}
}
if($weight){
if( abs($y - $food_coordinate[0]) > abs($snake_ghost[0][0] - $food_coordinate[0]) ||
abs($x - $food_coordinate[1]) > abs($snake_ghost[0][1] - $food_coordinate[1]) ){
unshift @feasible,$next_move;  # 远离食物放到数组头
}
else{
push @feasible,$next_move;  # 其他路径放在末尾
}
}
}
print "    feasible:@feasible\n" if DEBUG;
foreach(@feasible){
@path=();
$cur_move=$_;
print "    cur_move:$cur_move\n" if DEBUG;
my @one234 = ();  # 将当前移动方向设置为初始方向
given($cur_move){
when(1){ @one234 = @uldr;}
when(2){ @one234 = @uldr[0,2,3,4,1]; }
when(3){ @one234 = @uldr[0,3,4,1,2]; }
when(4){ @one234 = @uldr[0,4,1,2,3]; }
}
#################################################################
# 指定方向深度搜索
my ($step,$p_step)=(0,'');
do{
if($bg_ghost[ $cur_position->[0] ][ $cur_position->[1] ] == 0 ){
$bg_ghost[ $cur_position->[0] ][ $cur_position->[1] ]=1;
# 当前移动方向的反方向点不可经过，即禁止回退
$bg_ghost[ $snake_ghost[0][0]+$uldr[$opposite{$cur_move}]->[0] ][ $snake_ghost[0][1]+$uldr[$opposite{$cur_move}]->[1] ] = 2;
$bg_ghost[ $snake_ghost[0][0] ][ $snake_ghost[0][1] ] = 2;  # 当前点不可返回
if( $cur_position->[0] == $food_coordinate[0] && $cur_position->[1] == $food_coordinate[1] ){
push @snake_ghost,[ $snake_ghost[-1][0],$snake_ghost[-1][0] ];
}
$path[$step]={step=>$step,
coordinate=>[$cur_position->[0],$cur_position->[1]],
direct=>1,
};
$path[$step]->{direct}=4 if($step == 0);  # 起点不可再做起点
print "    path[$step]:$path[$step]:",$path[$step]->{step},"\n" if DEBUG;
if(DEBUG){
print @$_,"\n" foreach(@bg_ghost);
}
if( $cur_position->[0]==$end->[0] && $cur_position->[1]==$end->[1]){
my @arr=('A'..'Z','a'..'z');
foreach(0..$#path){
$bg_ghost[ $path[$_]->{coordinate}->[0] ][ $path[$_]->{coordinate}->[1] ] = $arr[$_];
}
print "    trace_tail: return $cur_move\n" if DEBUG;
return $cur_move;  # 有可行方向，返回
}
$step++;
if($step>1 && $step<=$#snake_ghost){
$bg_ghost[ $snake_ghost[$tail][0] ][ $snake_ghost[$tail][1] ] = 0
if ( $bg_ghost[ $snake_ghost[$tail][0] ][ $snake_ghost[$tail][1] ] == 2 );  # 每移动一次，将蛇尾所在坐标设未经过
$tail=($tail>0)?($tail-1):1;
}
$cur_position=[ $path[$step-1]->{coordinate}->[0]+$one234[1]->[0],
$path[$step-1]->{coordinate}->[1]+$one234[1]->[1] ];
print "    (y,x):(",$cur_position->[0],",",$cur_position->[1],")\n" if DEBUG;
}
else{
if(@path){
$p_step=pop(@path);
while($p_step->{direct}==4 && (@path)){
$bg_ghost[ $p_step->{coordinate}->[0] ][ $p_step->{coordinate}->[1] ] = 2;
$p_step=pop(@path);
$step--;

$tail=($tail<$#snake_ghost-1)?($tail+1):$#snake_ghost-1;
$bg_ghost[ $snake_ghost[$tail][0] ][ $snake_ghost[$tail][1] ] = 2
if ( $bg_ghost[ $snake_ghost[$tail][0] ][ $snake_ghost[$tail][1] ] == 0 );  # 每回退一次，将蛇尾所在坐标设为不可通过

}
if($p_step->{direct}<4){
$p_step->{direct}++;
print "        ",$p_step->{step},":p_step->{direct}:",$p_step->{direct},"\n" if DEBUG;
push @path,$p_step;
my @temp=@{$p_step->{coordinate}}[0,1];
$cur_position = [ $temp[0]+$one234[$p_step->{direct}]->[0],
$temp[1]+$one234[$p_step->{direct}]->[1] ];
print "        (y,x):(",$cur_position->[0],",",$cur_position->[1],")\n" if DEBUG;
}
}
}
}while(@path);
# 指定方向深度搜索结束
#################################################################
}
print "    cur_move:$cur_move  trace_tail:return fail\n" if DEBUG;
return $cur_move;  # 没有到尾巴的可行方向了，准备认命
}
#######################################################################################
# 能否到尾巴位置，能返回1，否则返回0
# 算法大致与 trace_tail 相同
sub head_to_tail{
print "call head_to_tail\n" if DEBUG;
my ($p_snake,$p_path)=@_;
my @snake_ghost=@$p_snake;
my @path=@$p_path;
my $cur_move=$path[-1];
my @arr=();
foreach(0..$#path){
my ($y,$x)=( $snake_ghost[0][0]+$uldr[ $path[$_] ]->[0],$snake_ghost[0][1]+$uldr[ $path[$_] ]->[1] );
unshift @snake_ghost,[$y,$x];
pop @snake_ghost if($_ < $#path);
}  # 影子蛇先行，吃到食物后的状态
@path=();
my $cur_position=[ $snake_ghost[0][0],$snake_ghost[0][1] ];
print "    cur_position:",$snake_ghost[0][0],",",$snake_ghost[0][1],"\n" if DEBUG;
my $end=[ $snake_ghost[-1][0],$snake_ghost[-1][1] ];
my $tail=$#snake_ghost;

my @bg_ghost=map{ [ split('','0'x WIDTH) ] }0..(HEIGHT-1);  # 0--未经过 1--已走 2--不可通过
map{ my $y=$_;map { $bg_ghost[$y][$_] = ( $bg[$y][$_] eq '*' )?2:0 }0..$#{$bg[0]} }0..$#bg;
map{ $bg_ghost[ $snake_ghost[$_][0] ][ $snake_ghost[$_][1] ] = 2 } 1..$#snake_ghost;  # 蛇身不可通过
my @feasible=();
my @next_moves=grep{ ! /$opposite{$cur_move}/ }values %opposite;
my $weight=0;
foreach(@next_moves){
$weight=1;
my $next_move=$_;
my ($y,$x)=( $snake_ghost[0][0]+$uldr[$next_move][0],$snake_ghost[0][1]+$uldr[$next_move][1] );
# 防止越界
if( $y < 1 || $y > HEIGHT-2 || $x < 1 || $x > WIDTH-2){
$weight=0;
next;
}

# 防止吃到自己
foreach(0..$#snake_ghost){
if( $y == $snake_ghost[$_][0] && $x == $snake_ghost[$_][1] ){
$weight=0;
last;
}
}
if($weight){
push @feasible,$next_move;  # 路径随意放
}
}
print "    feasible:@feasible\n" if DEBUG;
foreach(@feasible){
@path=();
$cur_move=$_;
my @one234 = ();  # 将当前移动方向设置为初始方向
given($cur_move){
when(1){ @one234 = @uldr;}
when(2){ @one234 = @uldr[0,2,3,4,1]; }
when(3){ @one234 = @uldr[0,3,4,1,2]; }
when(4){ @one234 = @uldr[0,4,1,2,3]; }
}
#################################################################
# 指定方向深度搜索
my ($step,$p_step)=(0,'');
do{
if($bg_ghost[ $cur_position->[0] ][ $cur_position->[1] ] == 0 ){
$bg_ghost[ $cur_position->[0] ][ $cur_position->[1] ]=1;
$bg_ghost[ $snake_ghost[0][0]+$uldr[$opposite{$cur_move}]->[0] ][ $snake_ghost[0][1]+$uldr[$opposite{$cur_move}]->[1] ] = 2;
$bg_ghost[ $snake_ghost[0][0] ][ $snake_ghost[0][1] ] = 2;  # 当前点不可返回
$path[$step]={step=>$step,
coordinate=>[$cur_position->[0],$cur_position->[1]],
direct=>1,
};
$path[$step]->{direct}=4 if($step == 0);  # 起点不可再做起点
print "    path[$step]:$path[$step]:",$path[$step]->{step},"\n" if DEBUG;
if( $cur_position->[0]==$end->[0] && $cur_position->[1]==$end->[1]){
my @arr=('A'..'Z','a'..'z');
foreach(0..$#path){
$bg_ghost[ $path[$_]->{coordinate}->[0] ][ $path[$_]->{coordinate}->[1] ] = $arr[$_];
}
print "    head_to_tail: return 1\n" if DEBUG;
return 1;
}
$step++;
if($step>1 && $step<=$#snake_ghost){
$bg_ghost[ $snake_ghost[$tail][0] ][ $snake_ghost[$tail][1] ] = 0
if ( $bg_ghost[ $snake_ghost[$tail][0] ][ $snake_ghost[$tail][1] ] == 2 );  # 每移动一次，将蛇尾所在坐标设未经过
$tail=($tail>0)?($tail-1):1;
}
$cur_position=[ $path[$step-1]->{coordinate}->[0]+$one234[1]->[0],
$path[$step-1]->{coordinate}->[1]+$one234[1]->[1] ];
print "    (y,x):(",$cur_position->[0],",",$cur_position->[1],")\n" if DEBUG;
}
else{
if(@path){
$p_step=pop(@path);
while($p_step->{direct}==4 && (@path)){
$bg_ghost[ $p_step->{coordinate}->[0] ][ $p_step->{coordinate}->[1] ] = 2;
$p_step=pop(@path);
$step--;
$tail=($tail<$#snake_ghost)?($tail+1):$#snake_ghost;
$bg_ghost[ $snake_ghost[$tail][0] ][ $snake_ghost[$tail][1] ] = 2
if ( $bg_ghost[ $snake_ghost[$tail][0] ][ $snake_ghost[$tail][1] ] == 0 );  # 每回退一次，将蛇尾所在坐标设为不可通过
if(DEBUG){
print @$_,"\n" foreach(@bg_ghost);
}
}
if($p_step->{direct}<4){
$p_step->{direct}++;
print "        ",$p_step->{step},":p_step->{direct}:",$p_step->{direct},"\n" if DEBUG;
push @path,$p_step;
my @temp=@{$p_step->{coordinate}}[0,1];
$cur_position = [ $temp[0]+$one234[$p_step->{direct}]->[0],
$temp[1]+$one234[$p_step->{direct}]->[1] ];
print "        (y,x):(",$cur_position->[0],",",$cur_position->[1],")\n" if DEBUG;
}
}
}
}while(@path);
# 指定方向深度搜索结束
#################################################################
}
print "    head_to_tail:return 0\n" if DEBUG;
return 0;
}
#######################################################################################
sub caclulate_cost{
my ($sp,$ep)=@_;
return abs($sp->[0] - $ep->[0]) + abs($sp->[1] - $ep->[1]);
}
#######################################################################################
# A*算法
sub a_star{
print "call a_star\n" if DEBUG;
my $start=shift;  # 起点
my $end=shift;  # 终点
my $p_arr=shift;
my @bg_ghost=@{$p_arr};

my @path=();  # 存放步数的数组
my @open_close=();
my ($step,$p_step,$p_gh)=(0,'','');  # 步数、指向数组元素的指针、指向open_close元素的指针
map{ my $y=$_;map { $open_close[$y][$_]->{flag} = ( $bg_ghost[$y][$_] eq '#' || $bg_ghost[$y][$_] eq '*')?2:0 }0..$#{$bg_ghost[0]} }0..$#bg;  # 障碍物设置不可通过

$path[$step]={ coordinate=>[$start->[0],$start->[1]],
cost=>0,
next_cost=>&caclulate_cost( $start,$end ),
previous=>0,
};
$path[$step]->{actual_cost}=$path[$step]->{cost} + $path[$step]->{next_cost};
$open_close[ $start->[0] ][ $start->[1] ]->{point}='';
while(@path){
$p_step=pop(@path);
print "  step:$step,p_step:$p_step\n" if DEBUG;
if( $p_step->{coordinate}->[0] == $end->[0] &&
$p_step->{coordinate}->[1] == $end->[1] ){
my @arr=();
my @temp=();
while($p_step){
push @temp,$p_step->{coordinate};
$p_step=$p_step->{previous};
}
@temp=reverse(@temp);
foreach(0..$#temp-1){
my $line=($temp[$_+1][0]-$temp[$_][0])."a".($temp[$_+1][1]-$temp[$_][1]);
given($line){
when('-1a0'){ push @arr,1 ;}
when('0a-1'){ push @arr,2 ;}
when('1a0') { push @arr,3 ;}
when('0a1') { push @arr,4 ;}
}  # 从父节点回溯，获取每一步移动方向
}
return @arr;
}
$step++;
for(my $cnt=1;$cnt<=4;$cnt++){
my $y= $p_step->{coordinate}->[0]+$uldr[$cnt][0] ;
my $x= $p_step->{coordinate}->[1]+$uldr[$cnt][1] ;
print "    ($p_step->{coordinate}->[0],$p_step->{coordinate}->[1])+($uldr[$cnt][0],$uldr[$cnt][1]),(y,x)=($y,$x)\n" if DEBUG;
next if( $open_close[$y][$x]->{flag} == 2 ||
$y < 1 || $y > HEIGHT-2 || $x < 1 || $x > WIDTH-2 );

if( $open_close[$y][$x]->{flag} == 0 ){
$open_close[$y][$x]->{flag}=1;
$open_close[$y][$x]->{point}=$p_step;
my $px={  coordinate=>[$y,$x],
cost=>$p_step->{cost}+1,
next_cost=>&caclulate_cost( [$y,$x],$end ),
previous=>$p_step,
};
$px->{actual_cost}=$px->{cost} + $px->{next_cost};
push @path,$px;
}
else{
$p_gh=$open_close[$y][$x]->{point};
print "      p_gh:$p_gh\n" if DEBUG;
if($p_gh && $p_step->{cost}+1 < $p_gh->{cost} ){
print "      $p_step->{cost},$p_gh->{cost}\n" if DEBUG;
$p_gh->{cost}=$p_step->{cost}+1;
$p_gh->{previous}=$p_step;
$p_gh->{actual_cost}=$p_gh->{cost}+$p_gh->{next_cost};
}
}
}
$open_close[ $p_step->{coordinate}->[0] ][ $p_step->{coordinate}->[1] ]->{flag}=1;
@path=sort{$b->{actual_cost}<=>$a->{actual_cost}}@path;
}
print "    a_star: return 0\n" if DEBUG;
return 0;
}
#######################################################################################
sub manual_move{
# 闭包，为了传入初始移动方向
my $move_direct=shift;
sub{
ReadMode 2;
my $key=ReadKey(-1);
$key=~tr/a-z/A-Z/ if $key;
given($key){
# 不允许反向移动
when('W'){ $move_direct = ( 3 == $move_direct )? 3 : 1 ; }
when('A'){ $move_direct = ( 4 == $move_direct )? 4 : 2 ; }
when('S'){ $move_direct = ( 1 == $move_direct )? 1 : 3 ; }
when('D'){ $move_direct = ( 2 == $move_direct )? 2 : 4 ; }
default { $move_direct; }
}
unshift @snake,[$snake[0][0]+$uldr[$move_direct][0],$snake[0][1]+$uldr[$move_direct][1]];
}
}
#######################################################################################
sub make_food{
if(@snake < $full){
my @empty_points=();
foreach(1..$#bg-1){
my $y=$_;
foreach(1..$#{$bg[0]}-1){
push @empty_points,[$y,$_] if($bg[$y][$_] eq ' ');
}
}  # 找出所有空的坐标点，存入@empty_points数组
my $num=int( rand( scalar(@empty_points) ) );  # 随机取出@empty_points下标
my ($y,$x)=@{ $empty_points[$num] }[0,1];
$bg[$y][$x]='O';
@food_coordinate=($y,$x);
$food=1;
}
}
#######################################################################################
sub check_head{
# 蛇身超出范围
if($snake[0][0] < 1 || $snake[0][0] > HEIGHT-2 ||
$snake[0][1] < 1 || $snake[0][1] > WIDTH-2 ){
$alive=0;
}
# 蛇吃到自己
if(@snake>3){
foreach(1..$#snake){
if($snake[0][0] == $snake[$_][0] &&  $snake[0][1] == $snake[$_][1]){
$alive=0;
}
}
}
# 移动
if($bg[$snake[0][0]][$snake[0][1]] eq ' '){
$bg[$snake[0][0]][$snake[0][1]]='@';
}
# 吃到食物
if($bg[$snake[0][0]][$snake[0][1]] eq 'O'){
$bg[$snake[0][0]][$snake[0][1]]='@';
$score++;
$food=0;
&make_food;
push @snake,[$snake[-1][0],$snake[-1][1]];  # 新的蛇身放在尾部
}
$bg[$snake[-1][0]][$snake[-1][1]]=' ';  # 先清除尾巴显示
pop @snake;  # 去掉尾巴
map{$bg[$snake[$_][0]][$snake[$_][1]]='#'}1..$#snake;  # 其他蛇身显示
}