Perl字符贪吃蛇

　　一时兴起，想试试能不能用perl实现字符贪吃蛇，算法如下：

　　定义2个数组@bg、@snake，@bg用来显示整个界面，@snake从蛇头开始保存蛇的坐标点。

　　蛇每移动一次，新的坐标点放到@snake头部，并去除最后一个元素，再改变@bg对应坐标的值。

　　通过控制台窗口不断清屏再打印，使蛇“看起来在移动”。

　　简单的速度控制实现：每次移动后sleep 若干秒。

　　感觉原来的make_food算法不够好，修改如下：

sub make_food{
    if(@snake < $full){
        my @empty_points=();
        foreach(..$#bg){
            my $y=$_;
            foreach(..$#{$bg[0]}){
                push @empty_points,[$y,$_] if($bg[$y][$_] eq '.');
            }
        }  # 找出所有空的坐标点，存入@empty_points数组
        until($food){
            my $num=int( rand( scalar(@empty_points) ) );  # 随机取出@empty_points下标
            my ($y,$x)=@{ $empty_points[$num] }[,];
            $bg[$y][$x]='O';
            $food=;
        }
    }
}

　　一个要解决的问题：无阻塞获取按键。通过度娘找到模块Term::ReadKey，新的问题产生了：批量输入方向，蛇会依次按照输入移动，暂时想不到好办法解决。

　　使用Time::HiRes的sleep，实现毫秒级等待，use 5.01 支持given...when语法。

　　使用 w a s d 控制移动，代码如下：

use strict;
use 5.01;
use Time::HiRes qw/sleep/;
use Term::ReadKey;
use constant {WIDTH=>,HEIGHT=>,DEBUG=>};
my @bg=();
my @snake=();
my ($score,$food,$speed,$alive)=(,,,); # 长度、食物、速度、存活
my $full=WIDTH*HEIGHT;
my %direct=( UP=>[-,],
            DOWN=>[,],
            LEFT=>[,-],
            RIGHT=>[,], ); # 移动方向
my $head='RIGHT'; # 初始移动方向

&init;
while($alive){
    $speed=($speed<)?(+int($score/)):;  # 速度控制
    if(@snake==$full){
        print "congratulations!\n";  # 蛇占满游戏区时显示
    }
    else{
        &move;
        &check_head;
        &show if $alive;
        sleep (-$speed*0.1);
    }
}

sub init{
    my $y=int(HEIGHT/);
    @bg=map{my $x=$_;[map{$bg[$x][$_]='.'}..WIDTH-]}..HEIGHT-;
    @{$bg[$y]}[,]=('#','@'); # 初始蛇身位置
    @snake=( [$y,],[$y,], ); # 保存蛇身坐标
    &make_food;  # 产生食物
}
sub show{
    system("cls");
    print "your score : $score\n";
    print "current speed : ",$speed,"\n\n";
    print @$_,"\n" foreach(@bg);
}
sub move{
    ReadMode ;
    my ($key,$cur);
    $key=ReadKey(-);
    $key=~tr/a-z/A-Z/ if $key;
    given($key){
        # 不允许反向移动
        when('W'){
            if($head eq 'DOWN'){
                $cur='DOWN';
            }
            else{
                $cur=$head='UP';
            }
        }
        when('A'){
            if($head eq 'RIGHT'){
                $cur='RIGHT';
            }
            else{
                $cur=$head='LEFT';
            }
        }
        when('S'){
            if($head eq 'UP'){
                $cur='UP';
            }
            else{
                $cur=$head='DOWN';
            }
        }
        when('D'){
            if($head eq 'LEFT'){
                $cur='LEFT';
            }
            else{
                $cur=$head='RIGHT';
            }
        }
        default { $cur=$head; }
    }
    unshift @snake,[$snake[][]+$direct{$cur}[],$snake[][]+$direct{$cur}[]];
}
sub make_food{
    if(@snake < $full){
        until($food){
            my ($x,$y)=(int(rand(WIDTH)),int(rand(HEIGHT)));
            if($bg[$y][$x] eq '.'){
                $bg[$y][$x]='O';
                $food=;
            }
        }
    }
}
sub check_head{
    # 蛇身超出范围
    if($snake[][] <  || $snake[][] > HEIGHT-
        || $snake[][] <  || $snake[][] > WIDTH-){
            $alive=;
    }
    # 蛇吃到自己
    if(@snake>){
        foreach(..$#snake){
            if($snake[][] == $snake[$_][] &&  $snake[][] == $snake[$_][]){
                $alive=;
            }
        }
    }
    # 移动
    if($bg[$snake[][]][$snake[][]] eq '.'){
        $bg[$snake[][]][$snake[][]]='@';
    }
    # 吃到食物
    if($bg[$snake[][]][$snake[][]] eq 'O'){
        $bg[$snake[][]][$snake[][]]='@';
        $score++;
        $food=;
        &make_food;
        push @snake,[$snake[-][],$snake[-][]];  # 新的蛇身放在尾部
    }
    $bg[$snake[-][]][$snake[-][]]='.';  # 先清除尾巴显示
    pop @snake;  # 去掉尾巴
    map{$bg[$snake[$_][]][$snake[$_][]]='#'}..$#snake;  # 其他蛇身显示
}

　　游戏界面：