初學(xué)練習(xí)，用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. #初始化游戲二維數(shù)組
    
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. #打印游戲當(dāng)前棋盤
    
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.     #驗(yàn)證
    
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. #當(dāng)前棋子樣式
    
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. }

復(fù)制代碼

小白·菜

請大家?guī)兔�看看，給點(diǎn)意見�？纯从惺裁吹胤叫枰�改進(jìn)？

infernor

牛X

dugu072_cu

這就是 5.10 的新語法了吧，記得看過一些介紹的，確實(shí)不習(xí)慣啊，Perl6似乎也這樣子了，不過應(yīng)該是沒有放棄以前的語法吧，考慮是不是得花時間關(guān)注下才是～

看了lz的代碼了，提個需求：平時的 棋類游戲 很少有敲坐標(biāo)下子的，一般都是一個光標(biāo)移到后，空格確認(rèn)后落子，這樣子更人性化一點(diǎn)
不過這個需求會很麻煩就是了，readline 就不行了， readkey 如果要處理 方向鍵更麻煩，當(dāng)然 wasd 四個鍵替代也不錯，期待lz的下一個版本～

小白·菜

原帖由 dugu072_cu 于 2009-11-28 15:29 發(fā)表
這就是 5.10 的新語法了吧，記得看過一些介紹的，確實(shí)不習(xí)慣啊，Perl6似乎也這樣子了，不過應(yīng)該是沒有放棄以前的語法吧，考慮是不是得花時間關(guān)注下才是～

看了lz的代碼了，提個需求：平時的 棋類游戲 很少有 ...

感謝您的意見。不過從命令行中獲取光標(biāo)這種事不知道 perl 能否做到？

dugu072_cu

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

realcriss

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

-_-|||

jhcom

呵呵，有意思的，下了一盤很不錯。

iamlimeng

贊一個，這哪是初學(xué)水平啊。

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

drvial

同樣是新手,差距就這么大呢