初學練習，用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;
}