初学练习，用Perl写的命令行五子棋

最近一周在学习 Perl ，刚看完小骆驼书。写点有趣的东西练习练习。灵感来自于这里 。

刚刚起步，可能有些地方还残留着其他语言的痕迹。如果有什么更好的写法请大家不吝赐教。

 

学习 Perl 是为了写一些处理文本的小工具，今后会陆续发出来的。预计第一个将是 Java 代码转换 AS3 代码的工具。

 

#!perl

use 5.010;
use strict;
use utf8;
binmode(STDIN, ':encoding(utf8)');
binmode(STDOUT, ':encoding(utf8)');
binmode(STDERR, ':encoding(utf8)');

my $cell=16;
my $cell_char="+";
my $turn = 1;
my (@cells, @line, @rows, $point, $msg);

&init;
while(1) {
    system "cls";
    &printCells;
    if(&checkWin) {
        say "[".(!$turn ? "Black" : "White")."] is win!";
        last;
    }
    say $msg if ($msg);
    $msg = undef;
    say "[".($turn ? "Black" : "White")."] side turn...";
    chomp($point = <STDIN>);
    unless ($point =~ s/([a-p]{2})/\L\1/i) {
        $msg = "Invalid input or out of range. \nPlease enter two character in a-z.";
        redo;
    }
    if (&downChess) {
        $turn = !$turn;
    } else {
        $msg = "Pieces already exist, can not be repeated. \nTry again!";
        redo;
    }
}

#初始化游戏二维数组
sub init {
    for(1..$cell) {
        my @line = split(/ /, "$cell_char " x $cell);
        push @cells, \@line;
    }
    @rows = 'a'..'p';
}

#打印游戏当前棋盘
sub printCells {
    say "  @rows";
    for(0..$cell-1){
        @line = @{$cells[$_]};
        say "$rows[$_] @line";
    }
}

#落子
sub downChess {
    #解析
    my $rowNum = &index(substr $point, 0, 1);
    my $colNum = &index(substr $point, 1, 1);
    #验证
    #return 0 if (!&isInRange($rowNum) or !&isInRange($colNum));
    return 0 unless ($cells[$rowNum]->[$colNum] eq $cell_char);
    #落子
    $cells[$rowNum]->[$colNum] = &turnChar($turn);
    return 1;
}

#当前棋子样式
sub turnChar {
    return $_[0] ? '@' : 'o';
}

sub isInRange {
    return $_[0] >= 0 and $_[0] <= $cell;
}

#传入char，返回与'a'的差
sub index {
    ord($_[0]) - ord('a');
}

#判断是否胜利
sub checkWin {
    return (&checkVerticalWin or &checkTraverseWin or &checkLeftCantWin);
}

#判断纵向胜利
sub checkVerticalWin {
    for my $index (0..$#cells) {
        my $time;
        for my $line (@cells) {
            if(@{$line}[$index] eq &turnChar(!$turn)) {
                $time++;
            } else {
                $time = 0;
            }
            if($time == 5) {
                return 1;
            }
        }
    }
    return 0;
}

#判断横向胜利
sub checkTraverseWin {
    for(@cells) {#0..$#cells) {
        my $time;
        for my $chess (@{$_}) {#$cells[$_]}) {
            if($chess eq &turnChar(!$turn)) {
                $time++;
            } else {
                $time = 0;
            }
            #say $time if($time != 0);
            if($time == 5) {
                return 1;
            }
        }
    }
    return 0;
}

#判断向左倾斜
sub checkLeftCantWin {
    for my $index (0..$#cells) {
        my ($time_right, $time_left, $temp_index);
        $temp_index = $index;
        for my $line (@cells) {
            #左上到右下，上半部分
            if(@{$line}[$temp_index] eq &turnChar(!$turn)) {
                $time_right++;
            } else {
                $time_right = 0;
            }
            #右上到左下，上半部分
            if(@{$line}[$#line-$temp_index] eq &turnChar(!$turn)) {
                $time_left++;
            } else {
                $time_left = 0;
            }
            $temp_index--;
            #say $time if ($time != 0);
            return 1 if($time_right == 5 or $time_left == 5);
            last if($temp_index < 0);
        }
        $time_right = 0;
        $time_left = 0;
        for my $line(reverse @cells) {
            #左上到右下，下半部分
            if(@{$line}[$#line-$index] eq &turnChar(!$turn)) {
                $time_right++;
            } else {
                $time_right = 0;
            }
            #右上到左下，下半部分
            if(@{$line}[$index] eq &turnChar(!$turn)) {
                $time_left++;
            } else {
                $time_left = 0;
            }
            $index--;
            #say $time if ($time != 0);
            return 1 if($time_right == 5 or $time_left == 5);
            last if($#line == $index);
        }
    }
    return 0;
}