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

小白·菜

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

1. #!perl
   
2. 
   
3. use 5.010;
   
4. use strict;
   
5. use utf8;
   
6. binmode(STDIN, ':encoding(utf8)');
   
7. binmode(STDOUT, ':encoding(utf8)');
   
8. binmode(STDERR, ':encoding(utf8)');
   
9. 
   
10. my $cell=16;
    
11. my $cell_char="+";
    
12. my $turn = 1;
    
13. my (@cells, @line, @rows, $point, $msg);
    
14. 
    
15. &init;
    
16. while(1) {
    
17.     system "cls";
    
18.     &printCells;
    
19.     if(&checkWin) {
    
20.         say "[".(!$turn ? "Black" : "White")."] is win!";
    
21.         last;
    
22.     }
    
23.     say $msg if ($msg);
    
24.     $msg = undef;
    
25.     say "[".($turn ? "Black" : "White")."] side turn...";
    
26.     chomp($point = <STDIN>);
    
27.     unless ($point =~ s/([a-p]{2})/\L\1/i) {
    
28.         $msg = "Invalid input or out of range. \nPlease enter two character in a-z.";
    
29.         redo;
    
30.     }
    
31.     if (&downChess) {
    
32.         $turn = !$turn;
    
33.     } else {
    
34.         $msg = "Pieces already exist, can not be repeated. \nTry again!";
    
35.         redo;
    
36.     }
    
37. }
    
38. 
    
39. #初始化游戏二维数组
    
40. sub init {
    
41.     for(1..$cell) {
    
42.         my @line = split(/ /, "$cell_char " x $cell);
    
43.         push @cells, \@line;
    
44.     }
    
45.     @rows = 'a'..'p';
    
46. }
    
47. 
    
48. #打印游戏当前棋盘
    
49. sub printCells {
    
50.     say "  @rows";
    
51.     for(0..$cell-1){
    
52.         @line = @{$cells[$_]};
    
53.         say "$rows[$_] @line";
    
54.     }
    
55. }
    
56. 
    
57. #落子
    
58. sub downChess {
    
59.     #解析
    
60.     my $rowNum = &index(substr $point, 0, 1);
    
61.     my $colNum = &index(substr $point, 1, 1);
    
62.     #验证
    
63.     #return 0 if (!&isInRange($rowNum) or !&isInRange($colNum));
    
64.     return 0 unless ($cells[$rowNum]->[$colNum] eq $cell_char);
    
65.     #落子
    
66.     $cells[$rowNum]->[$colNum] = &turnChar($turn);
    
67.     return 1;
    
68. }
    
69. 
    
70. #当前棋子样式
    
71. sub turnChar {
    
72.     return $_[0] ? '@' : 'o';
    
73. }
    
74. 
    
75. sub isInRange {
    
76.     return $_[0] >= 0 and $_[0] <= $cell;
    
77. }
    
78. 
    
79. #传入char，返回与'a'的差
    
80. sub index {
    
81.     ord($_[0]) - ord('a');
    
82. }
    
83. 
    
84. #判断是否胜利
    
85. sub checkWin {
    
86.     return (&checkVerticalWin or &checkTraverseWin or &checkLeftCantWin);
    
87. }
    
88. 
    
89. #判断纵向胜利
    
90. sub checkVerticalWin {
    
91.     for my $index (0..$#cells) {
    
92.         my $time;
    
93.         for my $line (@cells) {
    
94.             if(@{$line}[$index] eq &turnChar(!$turn)) {
    
95.                 $time++;
    
96.             } else {
    
97.                 $time = 0;
    
98.             }
    
99.             if($time == 5) {
    
100.                 return 1;
     
101.             }
     
102.         }
     
103.     }
     
104.     return 0;
     
105. }
     
106. 
     
107. #判断横向胜利
     
108. sub checkTraverseWin {
     
109.     for(@cells) {#0..$#cells) {
     
110.         my $time;
     
111.         for my $chess (@{$_}) {#$cells[$_]}) {
     
112.             if($chess eq &turnChar(!$turn)) {
     
113.                 $time++;
     
114.             } else {
     
115.                 $time = 0;
     
116.             }
     
117.             #say $time if($time != 0);
     
118.             if($time == 5) {
     
119.                 return 1;
     
120.             }
     
121.         }
     
122.     }
     
123.     return 0;
     
124. }
     
125. 
     
126. #判断向左倾斜
     
127. sub checkLeftCantWin {
     
128.     for my $index (0..$#cells) {
     
129.         my ($time_right, $time_left, $temp_index);
     
130.         $temp_index = $index;
     
131.         for my $line (@cells) {
     
132.             #左上到右下，上半部分
     
133.             if(@{$line}[$temp_index] eq &turnChar(!$turn)) {
     
134.                 $time_right++;
     
135.             } else {
     
136.                 $time_right = 0;
     
137.             }
     
138.             #右上到左下，上半部分
     
139.             if(@{$line}[$#line-$temp_index] eq &turnChar(!$turn)) {
     
140.                 $time_left++;
     
141.             } else {
     
142.                 $time_left = 0;
     
143.             }
     
144.             $temp_index--;
     
145.             #say $time if ($time != 0);
     
146.             return 1 if($time_right == 5 or $time_left == 5);
     
147.             last if($temp_index < 0);
     
148.         }
     
149.         $time_right = 0;
     
150.         $time_left = 0;
     
151.         for my $line(reverse @cells) {
     
152.             #左上到右下，下半部分
     
153.             if(@{$line}[$#line-$index] eq &turnChar(!$turn)) {
     
154.                 $time_right++;
     
155.             } else {
     
156.                 $time_right = 0;
     
157.             }
     
158.             #右上到左下，下半部分
     
159.             if(@{$line}[$index] eq &turnChar(!$turn)) {
     
160.                 $time_left++;
     
161.             } else {
     
162.                 $time_left = 0;
     
163.             }
     
164.             $index--;
     
165.             #say $time if ($time != 0);
     
166.             return 1 if($time_right == 5 or $time_left == 5);
     
167.             last if($#line == $index);
     
168.         }
     
169.     }
     
170.     return 0;
     
171. }

复制代码

小白·菜

请大家帮忙看看，给点意见。看看有什么地方需要改进？

infernor

牛X

dugu072_cu

这就是 5.10 的新语法了吧，记得看过一些介绍的，确实不习惯啊，Perl6似乎也这样子了，不过应该是没有放弃以前的语法吧，考虑是不是得花时间关注下才是～

看了lz的代码了，提个需求：平时的 棋类游戏 很少有敲坐标下子的，一般都是一个光标移到后，空格确认后落子，这样子更人性化一点
不过这个需求会很麻烦就是了，readline 就不行了， readkey 如果要处理 方向键更麻烦，当然 wasd 四个键替代也不错，期待lz的下一个版本～

小白·菜

原帖由 dugu072_cu 于 2009-11-28 15:29 发表
这就是 5.10 的新语法了吧，记得看过一些介绍的，确实不习惯啊，Perl6似乎也这样子了，不过应该是没有放弃以前的语法吧，考虑是不是得花时间关注下才是～

看了lz的代码了，提个需求：平时的 棋类游戏 很少有 ...

感谢您的意见。不过从命令行中获取光标这种事不知道 perl 能否做到？

dugu072_cu

windows 有 Win32::Console
其他平台 有 Term::ANSIScreen

realcriss

超级牛x的‘小白菜’呀。。。。

-_-|||

jhcom

呵呵，有意思的，下了一盘很不错。

iamlimeng

赞一个，这哪是初学水平啊。

建议用GUI界面，PERL是能做到的！

drvial

同样是新手,差距就这么大呢