File Coverage

blib/lib/Chess/Play.pm
Criterion Covered Total %
statement 90 983 9.1
branch 0 504 0.0
condition 0 158 0.0
subroutine 30 72 41.6
pod 13 42 30.9
total 133 1759 7.5


line stmt bran cond sub pod time code
1             package Chess::Play;
2              
3 1     1   38733 use strict;
  1         2  
  1         30  
4 1     1   5 use warnings;
  1         1  
  1         40  
5              
6             our $VERSION = '0.05';
7              
8 1     1   5 use constant IL => 99;
  1         6  
  1         87  
9 1     1   5 use constant EM => 0;
  1         2  
  1         62  
10 1     1   5 use constant WP => 1;
  1         1  
  1         49  
11 1     1   5 use constant WN => 2;
  1         1  
  1         37  
12 1     1   4 use constant WB => 3;
  1         1  
  1         35  
13 1     1   4 use constant WR => 4;
  1         1  
  1         37  
14 1     1   4 use constant WQ => 5;
  1         1  
  1         27  
15 1     1   4 use constant WK => 6;
  1         1  
  1         41  
16 1     1   4 use constant BP => -1;
  1         1  
  1         28  
17 1     1   4 use constant BN => -2;
  1         2  
  1         39  
18 1     1   4 use constant BB => -3;
  1         1  
  1         33  
19 1     1   9 use constant BR => -4;
  1         2  
  1         33  
20 1     1   4 use constant BQ => -5;
  1         1  
  1         33  
21 1     1   4 use constant BK => -6;
  1         6  
  1         29  
22              
23 1     1   3 use constant P_VAL => 1;
  1         2  
  1         31  
24 1     1   4 use constant N_VAL => 3;
  1         1  
  1         26  
25 1     1   4 use constant B_VAL => 3;
  1         1  
  1         34  
26 1     1   8 use constant R_VAL => 5;
  1         2  
  1         32  
27 1     1   4 use constant Q_VAL => 9;
  1         1  
  1         25  
28              
29 1     1   4 use constant WHITE => 1;
  1         1  
  1         32  
30 1     1   4 use constant BLACK => -1;
  1         1  
  1         26  
31              
32 1     1   4 use constant MOVES_50_THR => 99;
  1         1  
  1         33  
33 1     1   6 use constant CHECKMATE => 99;
  1         2  
  1         43  
34 1     1   4 use constant AB_CNST => 200;
  1         2  
  1         38  
35 1     1   5 use constant MAX_PIECE_VALUE => 15;
  1         2  
  1         86  
36              
37 1     1   5 use constant INVALID_MOVE => -1;
  1         1  
  1         35  
38 1     1   6 use constant ILLEGAL_MOVE => -2;
  1         2  
  1         53  
39 1     1   5 use constant LEGAL_MOVE => 1;
  1         1  
  1         11327  
40              
41             # ------------------------- METHODS -------------------------
42             # Basic methods
43             sub new {
44 0     0 1   my $class = shift;
45 0           my $self = {};
46              
47 0           $self->{BOARD} = [];
48 0           $self->{LAST_DOUBLE_MOVE} = [];
49 0           $self->{CASTLE_OK} = {};
50 0           $self->{UNDER_CHECK} = {};
51 0           $self->{RULE_50_MOVES} = undef;
52 0           $self->{PIECE_VAL} = {};
53 0           $self->{DEPTH} = undef;
54 0           $self->{COLOR_TO_MOVE} = undef;
55 0           $self->{FEN_MOVE_NUMBER} = undef;
56              
57 0           bless ($self, $class);
58 0           return $self;
59             }
60              
61             sub reset {
62 0     0 1   my $self = shift;
63              
64 0           $self->{BOARD} = [ IL, IL, IL, IL, IL, IL, IL, IL, IL, IL, IL, IL,
65             IL, IL, IL, IL, IL, IL, IL, IL, IL, IL, IL, IL,
66             IL, IL, WR, WN, WB, WQ, WK, WB, WN, WR, IL, IL,
67             IL, IL, WP, WP, WP, WP, WP, WP, WP, WP, IL, IL,
68             IL, IL, EM, EM, EM, EM, EM, EM, EM, EM, IL, IL,
69             IL, IL, EM, EM, EM, EM, EM, EM, EM, EM, IL, IL,
70             IL, IL, EM, EM, EM, EM, EM, EM, EM, EM, IL, IL,
71             IL, IL, EM, EM, EM, EM, EM, EM, EM, EM, IL, IL,
72             IL, IL, BP, BP, BP, BP, BP, BP, BP, BP, IL, IL,
73             IL, IL, BR, BN, BB, BQ, BK, BB, BN, BR, IL, IL,
74             IL, IL, IL, IL, IL, IL, IL, IL, IL, IL, IL, IL,
75             IL, IL, IL, IL, IL, IL, IL, IL, IL, IL, IL, IL ];
76              
77 0           $self->{LAST_DOUBLE_MOVE} = [ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ];
78              
79 0           $self->{CASTLE_OK} = {
80             E1G1 => 1,
81             E1C1 => 1,
82             E8G8 => 1,
83             E8C8 => 1,
84             };
85              
86 0           $self->{UNDER_CHECK} = {
87             W_K => 0,
88             B_K => 0,
89             };
90              
91 0           $self->{RULE_50_MOVES} = 0;
92              
93 0           $self->{PIECE_VAL}{+WP} = $self->{PIECE_VAL}{+BP} = P_VAL;
94 0           $self->{PIECE_VAL}{+WN} = $self->{PIECE_VAL}{+BN} = N_VAL;
95 0           $self->{PIECE_VAL}{+WB} = $self->{PIECE_VAL}{+BB} = B_VAL;
96 0           $self->{PIECE_VAL}{+WR} = $self->{PIECE_VAL}{+BR} = R_VAL;
97 0           $self->{PIECE_VAL}{+WQ} = $self->{PIECE_VAL}{+BQ} = Q_VAL;
98              
99 0           $self->{COLOR_TO_MOVE} = WHITE;
100              
101 0           $self->{FEN_MOVE_NUMBER} = 1;
102             }
103              
104             sub import_fen {
105 0     0 1   my ($self, $fen) = @_;
106 0           my ($r, $c, $sq);
107 0           my ($fen_1, $fen_2, $fen_3, $fen_4, $fen_5, $fen_6);
108              
109             #reset board to illegal
110 0           for (my $i = 0; $i < 144; $i++) {
111 0           $self->{BOARD}[$i] = IL;
112             }
113              
114 0           my @fen_arr = split(/ /, $fen);
115 0 0         die "Invalid FEN" if (@fen_arr != 6);
116              
117             # pieces' position
118 0           $fen_1 = $fen_arr[0];
119 0           my @fen_rows = split(/\//, $fen_1);
120 0 0         die "Invalid FEN - first element wrong" if (@fen_rows != 8);
121              
122 0           while ($fen_1 =~ /(\d)/g) {
123 0           my $num = $1;
124 0           my $rep = " " x $num;
125 0           $fen_1 =~ s/$num/$rep/;
126             }
127 0           $fen_1 =~ s/\///g;
128              
129 0           my $fen_i = 0;
130 0           for ($r = 7; $r >= 0; $r--) {
131 0           for ($c = 0; $c <= 7; $c++) {
132 0           $sq = 12 * ($r + 2) + 2 + $c;
133 0           my $fen_piece = substr($fen_1, $fen_i, 1);
134 0           $self->{BOARD}[$sq] = fen_to_board($fen_piece);
135 0           $fen_i++;
136             }
137             }
138              
139             # color to move
140 0           $fen_2 = $fen_arr[1];
141 0 0         if ($fen_2 eq "w") {
    0          
142 0           $self->{COLOR_TO_MOVE} = WHITE;
143             }
144             elsif ($fen_2 eq "b") {
145 0           $self->{COLOR_TO_MOVE} = BLACK;
146             }
147             else {
148 0           die "Invalid FEN - second element wrong";
149             }
150              
151             # castle flags
152 0           $fen_3 = $fen_arr[2];
153 0 0         if ($fen_3 =~ /K/) {
154 0           $self->{CASTLE_OK}{E1G1} = 1;
155             }
156             else {
157 0           $self->{CASTLE_OK}{E1G1} = 0;
158             }
159 0 0         if ($fen_3 =~ /Q/) {
160 0           $self->{CASTLE_OK}{E1C1} = 1;
161             }
162             else {
163 0           $self->{CASTLE_OK}{E1C1} = 0;
164             }
165 0 0         if ($fen_3 =~ /k/) {
166 0           $self->{CASTLE_OK}{E8G8} = 1;
167             }
168             else {
169 0           $self->{CASTLE_OK}{E8G8} = 0;
170             }
171 0 0         if ($fen_3 =~ /q/) {
172 0           $self->{CASTLE_OK}{E8C8} = 1;
173             }
174             else {
175 0           $self->{CASTLE_OK}{E8C8} = 0;
176             }
177              
178             # en passant
179 0           $self->{LAST_DOUBLE_MOVE} = [ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ];
180 0           $fen_4 = $fen_arr[3];
181 0 0         if ($fen_4 =~ /([a-h])3/) { # double pawn move for white
    0          
182 0           my $column = ord($1)-97;
183 0           $self->{LAST_DOUBLE_MOVE}[$column] = 1;
184             }
185             elsif ($fen_4 =~ /([a-h])6/) { # double pawn move for black
186 0           my $column = ord($1)-97;
187 0           $self->{LAST_DOUBLE_MOVE}[8+$column] = 1;
188             }
189              
190             # halfmove clock
191 0           $fen_5 = $fen_arr[4];
192 0 0         die "Invalid FEN - fifth element wrong" if (not ($fen_5 =~ /\d/));
193 0           $self->{RULE_50_MOVES} = $fen_5;
194              
195             # fullmove clock
196 0           $fen_6 = $fen_arr[5];
197 0           $self->{FEN_MOVE_NUMBER} = $fen_6;
198              
199             # check flags
200 0 0         if ($self->can_capture_king(-$self->{COLOR_TO_MOVE})) {
201 0 0         if ($self->{COLOR_TO_MOVE} == WHITE) {
202 0           $self->{UNDER_CHECK}{W_K} = 1;
203 0           $self->{UNDER_CHECK}{B_K} = 0;
204             }
205             else {
206 0           $self->{UNDER_CHECK}{W_K} = 0;
207 0           $self->{UNDER_CHECK}{B_K} = 1;
208             }
209             }
210             else {
211 0           $self->{UNDER_CHECK}{B_K} = 0;
212 0           $self->{UNDER_CHECK}{W_K} = 0;
213             }
214              
215             # sad necessity
216 0           $self->{PIECE_VAL}{+WP} = $self->{PIECE_VAL}{+BP} = P_VAL;
217 0           $self->{PIECE_VAL}{+WN} = $self->{PIECE_VAL}{+BN} = N_VAL;
218 0           $self->{PIECE_VAL}{+WB} = $self->{PIECE_VAL}{+BB} = B_VAL;
219 0           $self->{PIECE_VAL}{+WR} = $self->{PIECE_VAL}{+BR} = R_VAL;
220 0           $self->{PIECE_VAL}{+WQ} = $self->{PIECE_VAL}{+BQ} = Q_VAL;
221             }
222              
223             sub export_fen {
224 0     0 1   my $self = shift;
225 0           my ($r, $c, $sq);
226 0           my ($fen_1, $fen_2, $fen_3, $fen_4, $fen_5, $fen_6, $fen);
227              
228 0           $fen_1 = "";
229 0           for ($r = 7; $r >= 0; $r--) {
230 0           for ($c = 0; $c <= 7; $c++) {
231 0           $sq = 12 * ($r + 2) + 2 + $c;
232 0           my $str = value_to_string($self->{BOARD}[$sq]);
233 0           $fen_1 = $fen_1 . $str;
234             }
235 0           $fen_1 = $fen_1 . '/';
236             }
237 0           $fen_1 =~ s/\/$//;
238 0           while ($fen_1 =~ /( +)/g) {
239 0           my $spaces = $1;
240 0           my $nb_spaces = length($spaces);
241              
242 0           $fen_1 =~ s/$spaces/$nb_spaces/;
243             }
244              
245 0 0         if ($self->{COLOR_TO_MOVE} == WHITE) {
246 0           $fen_2 = "w";
247             }
248             else {
249 0           $fen_2 = "b";
250             }
251              
252 0           $fen_3 = "";
253 0 0         $fen_3 = $fen_3 . "K" if ($self->{CASTLE_OK}{E1G1});
254 0 0         $fen_3 = $fen_3 . "Q" if ($self->{CASTLE_OK}{E1C1});
255 0 0         $fen_3 = $fen_3 . "k" if ($self->{CASTLE_OK}{E8G8});
256 0 0         $fen_3 = $fen_3 . "q" if ($self->{CASTLE_OK}{E8C8});
257 0 0         $fen_3 = "-" if (not $fen_3);
258              
259 0           $fen_4 = "-";
260 0           for (my $ldm = 0; $ldm < 16; $ldm++) {
261 0 0         if ($self->{LAST_DOUBLE_MOVE}[$ldm]) {
262 0 0         if ($ldm < 8) {
263 0           $fen_4 = chr(97+$ldm) . "3";
264             }
265             else {
266 0           $fen_4 = chr(97+$ldm-8) . "6";
267             }
268 0           last;
269             }
270             }
271              
272 0           $fen_5 = $self->{RULE_50_MOVES};
273              
274 0           $fen_6 = $self->{FEN_MOVE_NUMBER};
275              
276 0           $fen = "$fen_1 $fen_2 $fen_3 $fen_4 $fen_5 $fen_6";
277 0           return $fen;
278             }
279              
280             sub fen_to_board {
281 0     0 0   my $fen_piece = shift;
282              
283 0 0         return EM if ($fen_piece eq " ");
284              
285 0 0         return WR if ($fen_piece eq "R");
286 0 0         return WN if ($fen_piece eq "N");
287 0 0         return WB if ($fen_piece eq "B");
288 0 0         return WQ if ($fen_piece eq "Q");
289 0 0         return WK if ($fen_piece eq "K");
290 0 0         return WP if ($fen_piece eq "P");
291              
292 0 0         return BR if ($fen_piece eq "r");
293 0 0         return BN if ($fen_piece eq "n");
294 0 0         return BB if ($fen_piece eq "b");
295 0 0         return BQ if ($fen_piece eq "q");
296 0 0         return BK if ($fen_piece eq "k");
297 0 0         return BP if ($fen_piece eq "p");
298              
299 0           die "Wrong value in FEN strin : $fen_piece";
300             }
301              
302             sub set_piece_val {
303 0 0   0 1   die "set_piece_val: wrong number of parameters" if (@_ != 6);
304              
305 0           my ($self, $p_val, $n_val, $b_val, $r_val, $q_val) = @_;
306              
307 0 0 0       if ( (($p_val <= 0) or ($p_val > MAX_PIECE_VALUE)) or
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
308             (($n_val <= 0) or ($n_val > MAX_PIECE_VALUE)) or
309             (($b_val <= 0) or ($b_val > MAX_PIECE_VALUE)) or
310             (($r_val <= 0) or ($r_val > MAX_PIECE_VALUE)) or
311             (($q_val <= 0) or ($q_val > MAX_PIECE_VALUE)) ) {
312 0           die ("set_piece_val: Values must be between 0 and " . MAX_PIECE_VALUE);
313             }
314              
315 0           $self->{PIECE_VAL}{+WP} = $self->{PIECE_VAL}{+BP} = $p_val;
316 0           $self->{PIECE_VAL}{+WN} = $self->{PIECE_VAL}{+BN} = $n_val;
317 0           $self->{PIECE_VAL}{+WB} = $self->{PIECE_VAL}{+BB} = $b_val;
318 0           $self->{PIECE_VAL}{+WR} = $self->{PIECE_VAL}{+BR} = $r_val;
319 0           $self->{PIECE_VAL}{+WQ} = $self->{PIECE_VAL}{+BQ} = $q_val;
320             }
321              
322             sub set_depth {
323 0     0 1   my ($self, $depth) = @_;
324              
325 0           $self->{DEPTH} = $depth;
326             }
327              
328             sub legal_moves {
329 0     0 1   my $self = shift;
330              
331 0           my @legal_moves = $self->generate_legal_moves($self->{COLOR_TO_MOVE});
332 0           foreach my $lm(@legal_moves) {
333 0           $lm = move_to_coord($lm);
334             }
335 0           sort @legal_moves;
336             }
337              
338             sub do_move {
339 0     0 1   my ($self, $move) = @_;
340              
341 0 0         if (not ($move =~ /^[a-h][1-8][a-h][1-8](n|b|r|q)?$/)) {
342 0           return INVALID_MOVE;
343             }
344              
345 0           my @legal_moves = $self->legal_moves();
346 0           my $is_legal = 0;
347 0           foreach my $lm(@legal_moves) {
348 0 0         if ($move eq $lm) {
349 0           $is_legal = 1;
350 0           last;
351             }
352             }
353 0 0         return ILLEGAL_MOVE if (not $is_legal);
354              
355 0           $self->execute_move(coord_to_move($move));
356 0           return LEGAL_MOVE;
357             }
358              
359             sub game_over {
360 0     0 1   my $self = shift;
361              
362 0 0         if ( $self->insuff_material() ) {
363 0           return "1/2-1/2 {insufficient material}";
364             }
365 0 0         if ( $self->rule50moves() ) {
366 0           return "1/2-1/2 {50 moves rule}";
367             }
368              
369 0           my @legal_moves = $self->legal_moves();
370 0 0         if (@legal_moves) {
    0          
    0          
371 0           return "";
372             }
373             elsif ($self->{UNDER_CHECK}{W_K}) {
374 0           return "0-1";
375             }
376             elsif ($self->{UNDER_CHECK}{B_K}) {
377 0           return "1-0";
378             }
379             else {
380 0           return "1/2-1/2 {Stalemate}";
381             }
382             }
383              
384             sub best_move {
385 0     0 1   my $self = shift;
386              
387 0           my ($evaluation, $bestmove);
388              
389 0 0         if ($self->{DEPTH} == 0) { #RANDOM MOVE
390 0           my @legal_moves = $self->legal_moves();
391 0           my $nb_legal_moves = @legal_moves;
392 0           $bestmove = $legal_moves[int(rand($nb_legal_moves))];
393 0           $bestmove = coord_to_move($bestmove);
394             }
395             else {
396 0           $evaluation = $self->alphabeta_search($self->{DEPTH}, -(AB_CNST), AB_CNST, -$self->{COLOR_TO_MOVE}, \$bestmove);
397             }
398              
399 0           return move_to_coord($bestmove);
400             }
401              
402             sub print_board {
403 0     0 1   my $self = shift;
404              
405 0           my ($r, $c, $sq);
406 0           for ($r = 7; $r >= 0; $r--) {
407 0           for ($c = 0; $c <= 7; $c++) {
408 0           $sq = 12 * ($r + 2) + 2 + $c;
409 0           my $str = value_to_string($self->{BOARD}[$sq]);
410 0           print "$str ";
411             }
412 0           print "\n";
413             }
414             }
415              
416             sub play {
417 0     0 1   my $self = shift;
418              
419 0           my $answer = "";
420 0           while ($answer ne "N") {
421 0           $answer = $self->play_one_game();
422             }
423             }
424              
425             sub xboard_play {
426 0     0 1   my $self = shift;
427 0   0       my $engine_name = shift || "My Chess::Play Engine";
428              
429 0           my ($first_move_done, $white_to_move, $force, $cont);
430              
431 0           while (my $line = ) {
432 0           chomp($line);
433 0 0         if ($line eq "xboard") {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
434 0           print STDERR "\n";
435             }
436             elsif ($line eq "protover 2") {
437 0           print STDERR "Chess\n";
438 0           print STDERR "feature setboard=1 sigint=0 variants=\"normal\" draw=1 reuse=1 myname=\"${engine_name}\" done=1\n"
439             }
440             elsif ($line eq "new") {
441 0           $first_move_done = 0;
442 0           $white_to_move = 1;
443 0           $force = 0; #not in force mode
444 0           $self->reset();
445 0           $cont = 0;
446             }
447             elsif ($line eq "force") {
448 0           $force = 1;
449             }
450             elsif ($line eq "quit") {
451 0           exit;
452             }
453             elsif ($line eq "white") {
454 0           $white_to_move = 1;
455             }
456             elsif ($line eq "black") {
457 0           $white_to_move = 0;
458             }
459             elsif ($line eq "go") {
460 0           $force = 0;
461 0           $cont++;
462 0 0         if ($white_to_move) {
463 0           $self->white_move();
464             }
465             else {
466 0           $self->black_move();
467             }
468 0           $first_move_done = 1;
469             }
470             elsif ($line =~ /[a-h][1-8][a-h][1-8]/) {
471 0           $self->execute_move(coord_to_move($line));
472              
473 0 0         if (not $first_move_done) {
474 0           $white_to_move = 0;
475 0           $first_move_done = 1;
476             }
477 0 0         if (not $force) {
478 0           $cont++;
479 0 0         if ($white_to_move) {
480 0           $self->white_move();
481             }
482             else {
483 0           $self->black_move();
484             }
485             }
486             }
487             }
488             }
489              
490             # Other methods
491             sub count_material {
492 0     0 0   my $self = shift;
493              
494 0           my ($r, $c, $sq);
495 0           my %count_material;
496              
497 0           $count_material{+WR} = 0;
498 0           $count_material{+WN} = 0;
499 0           $count_material{+WB} = 0;
500 0           $count_material{+WP} = 0;
501 0           $count_material{+WQ} = 0;
502 0           $count_material{+WK} = 0;
503 0           $count_material{+BR} = 0;
504 0           $count_material{+BN} = 0;
505 0           $count_material{+BB} = 0;
506 0           $count_material{+BP} = 0;
507 0           $count_material{+BQ} = 0;
508 0           $count_material{+BK} = 0;
509              
510 0           for ($r = 7; $r >= 0; $r--) {
511 0           for ($c = 0; $c <= 7; $c++) {
512 0           $sq = 12 * ($r + 2) + 2 + $c;
513 0 0         $count_material{$self->{BOARD}[$sq]}++ if ($self->{BOARD}[$sq] != EM);
514             }
515             }
516              
517 0           \%count_material;
518             }
519              
520             sub insuff_material { # to improve
521 0     0 0   my $self = shift;
522              
523 0           my $ref_count_material = $self->count_material();
524 0           my %count_material = %{$ref_count_material};
  0            
525              
526 0           my $w_insuff = 0;
527 0           my $b_insuff = 0;
528              
529             #foreach my $cle(keys %count_material) {
530             # print "$cle $count_material{$cle}\n";
531             #}
532              
533 0 0         if ( ($count_material{+WP} + $count_material{+WR} + $count_material{+WQ}) == 0 ) {
534 0 0         $w_insuff = 1 if ( ($count_material{+WB} + $count_material{+WN}) <= 1 );
535             }
536 0 0         if ( ($count_material{+BP} + $count_material{+BR} + $count_material{+BQ}) == 0 ) {
537 0 0         $b_insuff = 1 if ( ($count_material{+BB} + $count_material{+BN}) <= 1 );
538             }
539              
540 0   0       return ($w_insuff and $b_insuff);
541             }
542              
543              
544             sub rule50moves {
545 0     0 0   my $self = shift;
546              
547 0 0         if ($self->{RULE_50_MOVES} == MOVES_50_THR) {
548 0           return 1;
549             }
550 0           return 0;
551             }
552              
553             sub knight_mvs {
554 0     0 0   my $self = shift;
555              
556 0           my $val = shift;
557 0           my $orig_square = shift;
558 0           my $dest_square;
559              
560 0           my @knight_mv = ();
561              
562 0           my @diffs = ( -25, -23, -14, -10, 10, 14, 23, 25 );
563 0           foreach my $diff(@diffs) {
564 0           $dest_square = $orig_square + $diff;
565 0 0         next if ($self->{BOARD}[$dest_square] == IL);
566 0 0         if (($val * $self->{BOARD}[$dest_square]) <= 0) { #enemy piece or empty square
567 0           push @knight_mv, "$orig_square $dest_square";
568             }
569             }
570 0           @knight_mv;
571             }
572              
573             sub bishop_mvs {
574 0     0 0   my $self = shift;
575              
576 0           my $val = shift;
577 0           my $orig_square = shift;
578 0           my $dest_square;
579             my $control;
580              
581 0           my @bishop_mv = ();
582              
583             #NE
584 0           for ($dest_square = $orig_square+13; $dest_square <= 143; $dest_square += 13) {
585 0 0         last if ($self->{BOARD}[$dest_square] == IL);
586 0           $control = $val * $self->{BOARD}[$dest_square];
587 0 0         last if ($control > 0);
588 0 0         if ($control <= 0) {
589 0           push @bishop_mv, "$orig_square $dest_square";
590             }
591 0 0         last if ($control < 0);
592             }
593             #SW
594 0           for ($dest_square = $orig_square-13; $dest_square >= 0; $dest_square -= 13) {
595 0 0         last if ($self->{BOARD}[$dest_square] == IL);
596 0           $control = $val * $self->{BOARD}[$dest_square];
597 0 0         last if ($control > 0);
598 0 0         if ($control <= 0) {
599 0           push @bishop_mv, "$orig_square $dest_square";
600             }
601 0 0         last if ($control < 0);
602             }
603             #NW
604 0           for ($dest_square = $orig_square+11; $dest_square <= 143; $dest_square += 11) {
605 0 0         last if ($self->{BOARD}[$dest_square] == IL);
606 0           $control = $val * $self->{BOARD}[$dest_square];
607 0 0         last if ($control > 0);
608 0 0         if ($control <= 0) {
609 0           push @bishop_mv, "$orig_square $dest_square";
610             }
611 0 0         last if ($control < 0);
612             }
613             #SE
614 0           for ($dest_square = $orig_square-11; $dest_square >= 0; $dest_square -= 11) {
615 0 0         last if ($self->{BOARD}[$dest_square] == IL);
616 0           $control = $val * $self->{BOARD}[$dest_square];
617 0 0         last if ($control > 0);
618 0 0         if ($control <= 0) {
619 0           push @bishop_mv, "$orig_square $dest_square";
620             }
621 0 0         last if ($control < 0);
622             }
623 0           @bishop_mv;
624             }
625              
626             sub rook_mvs {
627 0     0 0   my $self = shift;
628              
629 0           my $val = shift;
630 0           my $orig_square = shift;
631 0           my $dest_square;
632             my $control;
633              
634 0           my @rook_mv = ();
635              
636             #N
637 0           for ($dest_square = $orig_square+12; $dest_square <= 143; $dest_square += 12) {
638 0 0         last if ($self->{BOARD}[$dest_square] == IL);
639 0           $control = $val * $self->{BOARD}[$dest_square];
640 0 0         last if ($control > 0);
641 0 0         if ($control <= 0) {
642 0           push @rook_mv, "$orig_square $dest_square";
643             }
644 0 0         last if ($control < 0);
645             }
646             #S
647 0           for ($dest_square = $orig_square-12; $dest_square >= 0; $dest_square -= 12) {
648 0 0         last if ($self->{BOARD}[$dest_square] == IL);
649 0           $control = $val * $self->{BOARD}[$dest_square];
650 0 0         last if ($control > 0);
651 0 0         if ($control <= 0) {
652 0           push @rook_mv, "$orig_square $dest_square";
653             }
654 0 0         last if ($control < 0);
655             }
656             #E
657 0           for ($dest_square = $orig_square+1; $dest_square <= 143; $dest_square += 1) {
658 0 0         last if ($self->{BOARD}[$dest_square] == IL);
659 0           $control = $val * $self->{BOARD}[$dest_square];
660 0 0         last if ($control > 0);
661 0 0         if ($control <= 0) {
662 0           push @rook_mv, "$orig_square $dest_square";
663             }
664 0 0         last if ($control < 0);
665             }
666             #W
667 0           for ($dest_square = $orig_square-1; $dest_square >= 0; $dest_square -= 1) {
668 0 0         last if ($self->{BOARD}[$dest_square] == IL);
669 0           $control = $val * $self->{BOARD}[$dest_square];
670 0 0         last if ($control > 0);
671 0 0         if ($control <= 0) {
672 0           push @rook_mv, "$orig_square $dest_square";
673             }
674 0 0         last if ($control < 0);
675             }
676 0           @rook_mv;
677             }
678              
679             sub queen_mvs {
680 0     0 0   my $self = shift;
681              
682 0           my $val = shift;
683 0           my $orig_square = shift;
684              
685 0           my @queen_mv = ();
686 0           push @queen_mv, $self->bishop_mvs($val, $orig_square);
687 0           push @queen_mv, $self->rook_mvs($val, $orig_square);
688              
689 0           @queen_mv;
690             }
691              
692             sub pawn_mvs {
693 0     0 0   my $self = shift;
694              
695 0           my $val = shift;
696 0           my $orig_square = shift;
697 0           my $dest_square;
698            
699 0           my @pawn_mv = ();
700              
701 0 0         if ($val > 0) { # white pawn
702             # advance
703 0           $dest_square = $orig_square + 12;
704 0 0         if ($self->{BOARD}[$dest_square] == EM) {
705 0 0         if ($dest_square < 110) { # no promotion
706 0           push @pawn_mv, "$orig_square $dest_square";
707             }
708             else {
709 0           push @pawn_mv, "$orig_square $dest_square n";
710 0           push @pawn_mv, "$orig_square $dest_square b";
711 0           push @pawn_mv, "$orig_square $dest_square r";
712 0           push @pawn_mv, "$orig_square $dest_square q";
713             }
714             }
715              
716             # double move
717 0 0 0       if ( ($orig_square >= 38) && ($orig_square <= 45) ) { # second rank
718 0           $dest_square = $orig_square + 24;
719 0 0 0       if ( ($self->{BOARD}[$dest_square] == EM) and ($self->{BOARD}[$dest_square-12] == EM) ) {
720 0           push @pawn_mv, "$orig_square $dest_square";
721             }
722             }
723              
724             # left capture
725 0           $dest_square = $orig_square + 11;
726 0 0 0       if ( ($self->{BOARD}[$dest_square] != IL) && ($self->{BOARD}[$dest_square] < 0) ) {
727 0 0         if ($dest_square < 110) { # no promotion
728 0           push @pawn_mv, "$orig_square $dest_square";
729             }
730             else {
731 0           push @pawn_mv, "$orig_square $dest_square n";
732 0           push @pawn_mv, "$orig_square $dest_square b";
733 0           push @pawn_mv, "$orig_square $dest_square r";
734 0           push @pawn_mv, "$orig_square $dest_square q";
735             }
736             }
737              
738             # right capture
739 0           $dest_square = $orig_square + 13;
740 0 0 0       if ( ($self->{BOARD}[$dest_square] != IL) && ($self->{BOARD}[$dest_square] < 0) ) {
741 0 0         if ($dest_square < 110) { # no promotion
742 0           push @pawn_mv, "$orig_square $dest_square";
743             }
744             else {
745 0           push @pawn_mv, "$orig_square $dest_square n";
746 0           push @pawn_mv, "$orig_square $dest_square b";
747 0           push @pawn_mv, "$orig_square $dest_square r";
748 0           push @pawn_mv, "$orig_square $dest_square q";
749             }
750             }
751              
752             # en passant
753 0 0 0       if ( ($orig_square >= 74) && ($orig_square <= 81) ) { # fith rank
754 0           my $column = ($orig_square - 2) % 12;
755 0 0         if ($column < 7) { # right capture possible
756 0 0         if ($self->{LAST_DOUBLE_MOVE}[8+$column+1]) {
757 0           $dest_square = $orig_square + 13;
758 0           push @pawn_mv, "$orig_square $dest_square";
759             }
760             }
761 0 0         if ($column > 0) { # left capture possible
762 0 0         if ($self->{LAST_DOUBLE_MOVE}[8+$column-1]) {
763 0           $dest_square = $orig_square + 11;
764 0           push @pawn_mv, "$orig_square $dest_square";
765             }
766             }
767             }
768             }
769             else { # black pawn
770             # advance
771 0           $dest_square = $orig_square - 12;
772 0 0         if ($self->{BOARD}[$dest_square] == EM) {
773 0 0         if ($dest_square > 33) { # no promotion
774 0           push @pawn_mv, "$orig_square $dest_square";
775             }
776             else {
777 0           push @pawn_mv, "$orig_square $dest_square n";
778 0           push @pawn_mv, "$orig_square $dest_square b";
779 0           push @pawn_mv, "$orig_square $dest_square r";
780 0           push @pawn_mv, "$orig_square $dest_square q";
781             }
782             }
783              
784             # double move
785 0 0 0       if ( ($orig_square >= 98) && ($orig_square <= 105) ) { # seventh rank
786 0           $dest_square = $orig_square - 24;
787 0 0 0       if ( ($self->{BOARD}[$dest_square] == EM) and ($self->{BOARD}[$dest_square+12] == EM) ) {
788 0           push @pawn_mv, "$orig_square $dest_square";
789             }
790             }
791              
792             # left capture
793 0           $dest_square = $orig_square - 13;
794 0 0 0       if ( ($self->{BOARD}[$dest_square] != IL) && ($self->{BOARD}[$dest_square] > 0) ) {
795 0 0         if ($dest_square > 33) { # no promotion
796 0           push @pawn_mv, "$orig_square $dest_square";
797             }
798             else {
799 0           push @pawn_mv, "$orig_square $dest_square n";
800 0           push @pawn_mv, "$orig_square $dest_square b";
801 0           push @pawn_mv, "$orig_square $dest_square r";
802 0           push @pawn_mv, "$orig_square $dest_square q";
803             }
804             }
805              
806             # right capture
807 0           $dest_square = $orig_square - 11;
808 0 0 0       if ( ($self->{BOARD}[$dest_square] != IL) && ($self->{BOARD}[$dest_square] > 0) ) {
809 0 0         if ($dest_square > 33) { # no promotion
810 0           push @pawn_mv, "$orig_square $dest_square";
811             }
812             else {
813 0           push @pawn_mv, "$orig_square $dest_square n";
814 0           push @pawn_mv, "$orig_square $dest_square b";
815 0           push @pawn_mv, "$orig_square $dest_square r";
816 0           push @pawn_mv, "$orig_square $dest_square q";
817             }
818             }
819              
820             # en passant
821 0 0 0       if ( ($orig_square >= 62) && ($orig_square <= 69) ) { # fith rank
822 0           my $column = ($orig_square - 2) % 12;
823 0 0         if ($column < 7) { # right capture possible
824 0 0         if ($self->{LAST_DOUBLE_MOVE}[$column+1]) {
825 0           $dest_square = $orig_square - 11;
826 0           push @pawn_mv, "$orig_square $dest_square";
827             }
828             }
829 0 0         if ($column > 0) { # left capture possible
830 0 0         if ($self->{LAST_DOUBLE_MOVE}[$column-1]) {
831 0           $dest_square = $orig_square - 13;
832 0           push @pawn_mv, "$orig_square $dest_square";
833             }
834             }
835             }
836             }
837            
838 0           @pawn_mv;
839             }
840              
841             sub king_mvs {
842 0     0 0   my $self = shift;
843              
844 0           my $val = shift;
845 0           my $orig_square = shift;
846 0           my $dest_square;
847              
848 0           my @king_mv = ();
849              
850 0           my @diffs = ( -13, -12, -11, -1, 1, 11, 12, 13 );
851 0           foreach my $diff(@diffs) {
852 0           $dest_square = $orig_square + $diff;
853 0 0         next if ($self->{BOARD}[$dest_square] == IL);
854 0 0         if (($val * $self->{BOARD}[$dest_square]) <= 0) { #enemy piece or empty square
855 0           push @king_mv, "$orig_square $dest_square";
856             }
857             }
858              
859             # castle_code
860 0 0         if ($val > 0) { # white king
861 0 0         return @king_mv if ($self->{UNDER_CHECK}{W_K}); # white king under chack
862              
863             # short castle
864 0 0 0       if ( ($self->{CASTLE_OK}{E1G1}) and
      0        
      0        
865             ($self->{BOARD}[33] == WR) and # white right rook NOT captured
866             ($self->{BOARD}[31] == EM) and # f1 empty
867             ($self->{BOARD}[32] == EM) ) { # g1 empty
868 0           $dest_square = $orig_square + 2;
869 0           push @king_mv, "$orig_square $dest_square";
870             }
871             # long castle
872 0 0 0       if ( ($self->{CASTLE_OK}{E1C1}) and
      0        
      0        
      0        
873             ($self->{BOARD}[26] == WR) and # white left rook NOT captured
874             ($self->{BOARD}[29] == EM) and # d1 empty
875             ($self->{BOARD}[28] == EM) and # c1 empty
876             ($self->{BOARD}[27] == EM) ) { # b1 empty
877 0           $dest_square = $orig_square - 2;
878 0           push @king_mv, "$orig_square $dest_square";
879             }
880             }
881             else { # black king
882 0 0         return @king_mv if ($self->{UNDER_CHECK}{B_K}); # black king under chack
883             # short castle
884 0 0 0       if ( ($self->{CASTLE_OK}{E8G8}) and
      0        
      0        
885             ($self->{BOARD}[117] == BR) and # black right rook NOT captured
886             ($self->{BOARD}[115] == EM) and # f8 empty
887             ($self->{BOARD}[116] == EM) ) { # g8 empty
888 0           $dest_square = $orig_square + 2;
889 0           push @king_mv, "$orig_square $dest_square";
890             }
891              
892             # long castle
893 0 0 0       if ( ($self->{CASTLE_OK}{E8C8}) and
      0        
      0        
      0        
894             ($self->{BOARD}[110] == BR) and # black left rook NOT captured
895             ($self->{BOARD}[113] == EM) and # d8 empty
896             ($self->{BOARD}[112] == EM) and # c8 empty
897             ($self->{BOARD}[111] == EM) ) { # b8 empty
898 0           $dest_square = $orig_square - 2;
899 0           push @king_mv, "$orig_square $dest_square";
900             }
901             }
902              
903 0           @king_mv;
904             }
905              
906             sub generate_candidate_legal_moves {
907 0     0 0   my $self = shift;
908              
909 0           my $color = shift;
910 0           my @candidate_legal_moves = ();
911 0           my ($square, $control);
912 0           my $i;
913            
914 0           for ($i = 26; $i <= 117; $i++) {
915 0           $square = $self->{BOARD}[$i];
916 0           $control = $square * $color;
917              
918 0 0         next if ($square == IL); # bogus square
919 0 0         next if ($square == EM); # empty square
920 0 0         next if ( $control < 0 ); # enemy piece
921              
922 0 0         push @candidate_legal_moves, $self->pawn_mvs($square, $i) if ($control == WP);
923 0 0         push @candidate_legal_moves, $self->knight_mvs($square, $i) if ($control == WN);
924 0 0         push @candidate_legal_moves, $self->bishop_mvs($square, $i) if ($control == WB);
925 0 0         push @candidate_legal_moves, $self->rook_mvs($square, $i) if ($control == WR);
926 0 0         push @candidate_legal_moves, $self->queen_mvs($square, $i) if ($control == WQ);
927 0 0         push @candidate_legal_moves, $self->king_mvs($square, $i) if ($control == WK);
928             }
929              
930 0           @candidate_legal_moves;
931             }
932              
933             sub generate_legal_moves {
934 0     0 0   my $self = shift;
935              
936 0           my $color = shift;
937              
938             # castle legality control
939 0           my (%flag, %forbidden);
940 0           $flag{WK_e1f1} = 0;
941 0           $flag{WK_e1g1} = 0;
942 0           $flag{WK_e1d1} = 0;
943 0           $flag{WK_e1c1} = 0;
944 0           $flag{BK_e8f8} = 0;
945 0           $flag{BK_e8g8} = 0;
946 0           $flag{BK_e8d8} = 0;
947 0           $flag{BK_e8c8} = 0;
948            
949 0           my %tmp_legal_moves = ();
950 0           my @legal_moves = ();
951              
952 0           my @candidate_legal_moves = $self->generate_candidate_legal_moves($color);
953              
954 0           foreach my $cm(@candidate_legal_moves) {
955 0           my @squares = split(/ /, $cm);
956              
957 0           my $orig_square = $squares[0];
958            
959 0 0         if ($self->test_legality($cm)) {
960 0           $tmp_legal_moves{$cm} = 1;
961 0 0         if ($self->{BOARD}[$orig_square] == WK) {
    0          
962 0 0         if ($cm eq "30 31") {
    0          
    0          
    0          
963 0           $flag{WK_e1f1} = 1;
964             }
965             elsif ($cm eq "30 32") {
966 0           $flag{WK_e1g1} = 1;
967             }
968             elsif ($cm eq "30 29") {
969 0           $flag{WK_e1d1} = 1;
970             }
971             elsif ($cm eq "30 28") {
972 0           $flag{WK_e1c1} = 1;
973             }
974             }
975             elsif ($self->{BOARD}[$orig_square] == BK) {
976 0 0         if ($cm eq "114 115") {
    0          
    0          
    0          
977 0           $flag{BK_e8f8} = 1;
978             }
979             elsif ($cm eq "114 116") {
980 0           $flag{BK_e8g8} = 1;
981             }
982             elsif ($cm eq "114 113") {
983 0           $flag{BK_e8d8} = 1;
984             }
985             elsif ($cm eq "114 112") {
986 0           $flag{BK_e8c8} = 1;
987             }
988             }
989             }
990             }
991              
992             # Control for castle
993 0 0 0       $tmp_legal_moves{"30 32"} = 0 if ( (not $flag{WK_e1f1}) and $flag{WK_e1g1} );
994 0 0 0       $tmp_legal_moves{"30 28"} = 0 if ( (not $flag{WK_e1d1}) and $flag{WK_e1c1} );
995 0 0 0       $tmp_legal_moves{"114 116"} = 0 if ( (not $flag{BK_e8f8}) and $flag{BK_e8g8} );
996 0 0 0       $tmp_legal_moves{"114 112"} = 0 if ( (not $flag{BK_e8d8}) and $flag{BK_e8c8} );
997              
998 0           foreach my $tmp_move(keys %tmp_legal_moves) {
999 0 0         push @legal_moves, $tmp_move if ($tmp_legal_moves{$tmp_move});
1000             }
1001              
1002 0           @legal_moves;
1003             }
1004              
1005             sub execute_move {
1006 0     0 0   my $self = shift;
1007              
1008 0           my $move = shift;
1009 0           my @squares = split(/ /, $move);
1010              
1011 0           my $orig_square = $squares[0];
1012 0           my $dest_square = $squares[1];
1013 0           my $promotion = "";
1014 0 0         $promotion = $squares[2] if defined($squares[2]);
1015 0           my $moving_piece = $self->{BOARD}[$orig_square];
1016 0           my $moving_color = sign($moving_piece);
1017              
1018 0 0         $self->{FEN_MOVE_NUMBER}++ if ($moving_color == BLACK);
1019              
1020             # capture or pawn move
1021 0 0 0       if ( ($self->{BOARD}[$dest_square] != EM) or ($moving_piece == WP) or ($moving_piece == BP) ) {
      0        
1022 0           $self->{RULE_50_MOVES} = 0;
1023             }
1024             else {
1025 0           $self->{RULE_50_MOVES}++;
1026             }
1027              
1028 0           $self->{LAST_DOUBLE_MOVE} = [ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ];
1029              
1030             #castle
1031 0 0         if ($moving_piece == WK) {
    0          
1032 0           $self->{CASTLE_OK}{E1G1} = 0;
1033 0           $self->{CASTLE_OK}{E1C1} = 0;
1034 0 0         if ( ($dest_square - $orig_square) == 2 ) {
    0          
1035 0           $self->{BOARD}[33] = EM;
1036 0           $self->{BOARD}[31] = WR;
1037             }
1038             elsif ( ($dest_square - $orig_square) == -2 ) {
1039 0           $self->{BOARD}[26] = EM;
1040 0           $self->{BOARD}[29] = WR;
1041             }
1042             }
1043             elsif ($moving_piece == BK) {
1044 0           $self->{CASTLE_OK}{E8G8} = 0;
1045 0           $self->{CASTLE_OK}{E8C8} = 0;
1046 0 0         if ( ($dest_square - $orig_square) == 2 ) {
    0          
1047 0           $self->{BOARD}[117] = EM;
1048 0           $self->{BOARD}[115] = BR;
1049             }
1050             elsif ( ($dest_square - $orig_square) == -2 ) {
1051 0           $self->{BOARD}[110] = EM;
1052 0           $self->{BOARD}[113] = BR;
1053             }
1054             }
1055              
1056             # Pawn's special moves
1057 0           my $column;
1058 0 0         if ($moving_piece == WP) {
    0          
1059 0 0 0       if ( ($dest_square - $orig_square) == 24 ) { # double move
    0 0        
    0          
1060 0           $column = ($orig_square - 2) % 12;
1061 0           $self->{LAST_DOUBLE_MOVE}[$column] = 1;
1062             }
1063             elsif ( ( ($dest_square - $orig_square) == 13 ) and # en passant R
1064             ($self->{BOARD}[$dest_square] == EM) ) {
1065 0           $self->{BOARD}[$orig_square+1] = EM;
1066             }
1067             elsif ( ( ($dest_square - $orig_square) == 11 ) and # en passant L
1068             ($self->{BOARD}[$dest_square] == EM) ) {
1069 0           $self->{BOARD}[$orig_square-1] = EM;
1070             }
1071 0 0         if ($promotion eq "n") {
    0          
    0          
    0          
1072 0           $self->{BOARD}[$dest_square] = WN;
1073             }
1074             elsif ($promotion eq "b") {
1075 0           $self->{BOARD}[$dest_square] = WB;
1076             }
1077             elsif ($promotion eq "r") {
1078 0           $self->{BOARD}[$dest_square] = WR;
1079             }
1080             elsif ($promotion eq "q") {
1081 0           $self->{BOARD}[$dest_square] = WQ;
1082             }
1083             }
1084             elsif ($moving_piece == BP) {
1085 0 0 0       if ( ($dest_square - $orig_square) == -24 ) { # double move
    0 0        
    0          
1086 0           $column = ($orig_square - 2) % 12;
1087 0           $self->{LAST_DOUBLE_MOVE}[8+$column] = 1;
1088             }
1089             elsif ( ( ($dest_square - $orig_square) == -11 ) and # en passant R
1090             ($self->{BOARD}[$dest_square] == EM) ) {
1091 0           $self->{BOARD}[$orig_square+1] = EM;
1092             }
1093             elsif ( ( ($dest_square - $orig_square) == -13 ) and # en passant L
1094             ($self->{BOARD}[$dest_square] == EM) ) {
1095 0           $self->{BOARD}[$orig_square-1] = EM;
1096             }
1097              
1098 0 0         if ($promotion eq "n") {
    0          
    0          
    0          
1099 0           $self->{BOARD}[$dest_square] = BN;
1100             }
1101             elsif ($promotion eq "b") {
1102 0           $self->{BOARD}[$dest_square] = BB;
1103             }
1104             elsif ($promotion eq "r") {
1105 0           $self->{BOARD}[$dest_square] = BR;
1106             }
1107             elsif ($promotion eq "q") {
1108 0           $self->{BOARD}[$dest_square] = BQ;
1109             }
1110             }
1111              
1112             # Rooks moved => castle impossible
1113 0 0 0       if ( ($moving_piece == WR) and ($orig_square == 33) ) {
    0 0        
    0 0        
    0 0        
1114 0           $self->{CASTLE_OK}{E1G1} = 0;
1115             }
1116             elsif ( ($moving_piece == WR) and ($orig_square == 26) ) {
1117 0           $self->{CASTLE_OK}{E1C1} = 0;
1118             }
1119             elsif ( ($moving_piece == BR) and ($orig_square == 117) ) {
1120 0           $self->{CASTLE_OK}{E8G8} = 0;
1121             }
1122             elsif ( ($moving_piece == BR) and ($orig_square == 110) ) {
1123 0           $self->{CASTLE_OK}{E8G8} = 0;
1124             }
1125              
1126             # Capture in (a1, h1, a8, h8) => castle impossible
1127 0 0         if ($dest_square == 33) { # h1
    0          
    0          
    0          
1128 0           $self->{CASTLE_OK}{E1G1} = 0;
1129             }
1130             elsif ($dest_square == 26) { # a1
1131 0           $self->{CASTLE_OK}{E1C1} = 0;
1132             }
1133             elsif ($dest_square == 117) { # h8
1134 0           $self->{CASTLE_OK}{E8G8} = 0;
1135             }
1136             elsif ($dest_square == 110) { # a8
1137 0           $self->{CASTLE_OK}{E8C8} = 0;
1138             }
1139              
1140 0           $self->{BOARD}[$orig_square] = EM;
1141 0 0         $self->{BOARD}[$dest_square] = $moving_piece if (not $promotion);
1142              
1143 0 0         if ($self->can_capture_king($moving_color)) {
1144 0 0         if ($moving_color == 1) {
1145 0           $self->{UNDER_CHECK}{B_K} = 1;
1146 0           $self->{UNDER_CHECK}{W_K} = 0;
1147             }
1148             else {
1149 0           $self->{UNDER_CHECK}{B_K} = 0;
1150 0           $self->{UNDER_CHECK}{W_K} = 1;
1151             }
1152             }
1153             else {
1154 0           $self->{UNDER_CHECK}{B_K} = 0;
1155 0           $self->{UNDER_CHECK}{W_K} = 0;
1156             }
1157              
1158 0           $self->{COLOR_TO_MOVE} = -$moving_color;
1159             }
1160              
1161             sub can_capture_king {
1162 0     0 0   my $self = shift;
1163              
1164 0           my $color_to_move = shift;
1165              
1166 0           my $dest_square;
1167              
1168 0           my @moves = $self->generate_candidate_legal_moves($color_to_move);
1169 0           foreach my $move(@moves) {
1170 0           my @move_arr = split(/ /, $move);
1171              
1172 0           $dest_square = $move_arr[1];
1173 0 0         if ( ($color_to_move * $self->{BOARD}[$dest_square]) == BK ) {
1174 0           return 1;
1175             }
1176             }
1177 0           return 0;
1178             }
1179              
1180             sub test_legality {
1181 0     0 0   my $self = shift;
1182              
1183 0           my $move = shift;
1184 0           my $is_legal = 1;
1185              
1186 0           my @squares = split(/ /, $move);
1187 0           my $orig_square = $squares[0];
1188 0           my $moving_val = $self->{BOARD}[$orig_square];
1189 0           my $moving_color = sign($moving_val);
1190              
1191             # save context
1192 0           my @saved_board = @{ $self->{BOARD} };
  0            
1193 0           my @saved_last_double_move = @{ $self->{LAST_DOUBLE_MOVE} };
  0            
1194 0           my %saved_castle_ok = %{ $self->{CASTLE_OK} };
  0            
1195 0           my %saved_under_check = %{ $self->{UNDER_CHECK} };
  0            
1196 0           my $saved_rule_50_moves = $self->{RULE_50_MOVES};
1197 0           my $saved_color_to_move = $self->{COLOR_TO_MOVE};
1198 0           my $saved_move_number = $self->{FEN_MOVE_NUMBER};
1199              
1200             # execute move
1201 0           $self->execute_move($move);
1202              
1203             # see if an enemy piece can eat the king
1204 0 0         if ($self->can_capture_king(-$moving_color)) {
1205 0           $is_legal = 0;
1206             }
1207              
1208             # restore context
1209 0           @{ $self->{BOARD} } = @saved_board;
  0            
1210 0           @{ $self->{LAST_DOUBLE_MOVE} } = @saved_last_double_move;
  0            
1211 0           %{ $self->{CASTLE_OK} } = %saved_castle_ok;
  0            
1212 0           %{ $self->{UNDER_CHECK} } = %saved_under_check;
  0            
1213 0           $self->{RULE_50_MOVES} = $saved_rule_50_moves;
1214 0           $self->{COLOR_TO_MOVE} = $saved_color_to_move;
1215 0           $self->{FEN_MOVE_NUMBER} = $saved_move_number;
1216              
1217 0           return $is_legal;
1218             }
1219              
1220             # POSITION EVALUATION
1221             sub static_eval {
1222 0     0 0   my $self = shift;
1223              
1224 0           my ($r, $c, $sq, $piece, $delta);
1225              
1226 0           $delta = 0;
1227 0           for ($r = 7; $r >= 0; $r--) {
1228 0           for ($c = 0; $c <= 7; $c++) {
1229 0           $sq = 12 * ($r + 2) + 2 + $c;
1230 0           $piece = $self->{BOARD}[$sq];
1231 0 0 0       next if ( ($piece == EM) or ($piece == WK) or ($piece == BK) );
      0        
1232 0           $delta += ( $self->{PIECE_VAL}{$piece} * sign($piece) );
1233             }
1234             }
1235 0           return $delta;
1236             }
1237              
1238             sub evaluate {
1239 0     0 0   my ($self, $color) = @_; # Color which made the last move
1240              
1241 0 0         if ($color == WHITE) {
1242 0           my @legal_moves = $self->generate_legal_moves(BLACK);
1243 0 0         if (not @legal_moves) {
    0          
1244 0 0         if ($self->{UNDER_CHECK}{B_K}) {
1245 0           return -(CHECKMATE);
1246             }
1247             else {
1248 0           return 0;
1249             }
1250             }
1251             elsif ($self->rule50moves()) {
1252 0           return 0;
1253             }
1254             else {
1255 0           return -$self->static_eval();
1256             }
1257             }
1258             else {
1259 0           my @legal_moves = $self->generate_legal_moves(WHITE);
1260 0 0         if (not @legal_moves) {
    0          
1261 0 0         if ($self->{UNDER_CHECK}{W_K}) {
1262 0           return -(CHECKMATE);
1263             }
1264             else {
1265 0           return 0;
1266             }
1267             }
1268             elsif ($self->rule50moves()) {
1269 0           return 0;
1270             }
1271             else {
1272 0           return $self->static_eval();
1273             }
1274             }
1275             }
1276              
1277              
1278             sub alphabeta_search {
1279 0     0 0   my ($self, $depth, $alpha, $beta, $color, $ref_bestmove) = @_; # Color which made the last move
1280 0           my ($alphaL, $evaluation);
1281 0 0         if ($depth == 0) {
1282 0           return $self->evaluate($color);
1283             }
1284              
1285 0           $alphaL = $alpha;
1286 0 0         if ($color == WHITE) {
1287 0           my @legal_moves = $self->generate_legal_moves(BLACK);
1288 0 0         if (not @legal_moves) {
1289 0 0         if ($self->{UNDER_CHECK}{B_K}) {
1290 0           return -(CHECKMATE+$depth);
1291             }
1292             else {
1293 0           return 0;
1294             }
1295             }
1296             else {
1297             #BACKUP STATE
1298 0           my @saved_board = @{ $self->{BOARD} };
  0            
1299 0           my @saved_last_double_move = @{ $self->{LAST_DOUBLE_MOVE} };
  0            
1300 0           my %saved_castle_ok = %{ $self->{CASTLE_OK} };
  0            
1301 0           my %saved_under_check = %{ $self->{UNDER_CHECK} };
  0            
1302 0           my $saved_rule_50_moves = $self->{RULE_50_MOVES};
1303 0           my $saved_color_to_move = $self->{COLOR_TO_MOVE};
1304 0           my $saved_move_number = $self->{FEN_MOVE_NUMBER};
1305              
1306             #shuffle @legal_moves array
1307 0 0         fisher_yates_shuffle(\@legal_moves) if ($depth == $self->{DEPTH});
1308              
1309 0           foreach my $move(@legal_moves) {
1310 0           $self->execute_move($move);
1311              
1312 0           $evaluation = -$self->alphabeta_search($depth-1, -$beta, -$alphaL, -$color, $ref_bestmove);
1313              
1314             #RESTORE STATE
1315 0           @{ $self->{BOARD} } = @saved_board;
  0            
1316 0           @{ $self->{LAST_DOUBLE_MOVE} } = @saved_last_double_move;
  0            
1317 0           %{ $self->{CASTLE_OK} } = %saved_castle_ok;
  0            
1318 0           %{ $self->{UNDER_CHECK} } = %saved_under_check;
  0            
1319 0           $self->{RULE_50_MOVES} = $saved_rule_50_moves;
1320 0           $self->{COLOR_TO_MOVE} = $saved_color_to_move;
1321 0           $self->{FEN_MOVE_NUMBER} = $saved_move_number;
1322              
1323 0 0         if ($evaluation >= $beta) {
1324 0           return $beta;
1325             }
1326              
1327 0 0         if ($evaluation > $alphaL) {
1328 0           $alphaL = $evaluation;
1329 0 0         if ($depth == $self->{DEPTH}) {
1330 0           ${ $ref_bestmove } = $move;
  0            
1331             }
1332             }
1333             }
1334 0           return $alphaL;
1335             }
1336             }
1337             else {
1338 0           my @legal_moves = $self->generate_legal_moves(WHITE);
1339 0 0         if (not @legal_moves) {
1340 0 0         if ($self->{UNDER_CHECK}{W_K}) {
1341 0           return -(CHECKMATE+$depth);
1342             }
1343             else {
1344 0           return 0;
1345             }
1346             }
1347             else {
1348             #BACKUP STATE
1349 0           my @saved_board = @{ $self->{BOARD} };
  0            
1350 0           my @saved_last_double_move = @{ $self->{LAST_DOUBLE_MOVE} };
  0            
1351 0           my %saved_castle_ok = %{ $self->{CASTLE_OK} };
  0            
1352 0           my %saved_under_check = %{ $self->{UNDER_CHECK} };
  0            
1353 0           my $saved_rule_50_moves = $self->{RULE_50_MOVES};
1354 0           my $saved_color_to_move = $self->{COLOR_TO_MOVE};
1355 0           my $saved_move_number = $self->{FEN_MOVE_NUMBER};
1356              
1357             #shuffle @legal_moves array
1358 0 0         fisher_yates_shuffle(\@legal_moves) if ($depth == $self->{DEPTH});
1359              
1360 0           foreach my $move(@legal_moves) {
1361 0           $self->execute_move($move);
1362 0           $evaluation = -$self->alphabeta_search($depth-1, -$beta, -$alphaL, -$color, $ref_bestmove);
1363              
1364             #RESTORE STATE
1365 0           @{ $self->{BOARD} } = @saved_board;
  0            
1366 0           @{ $self->{LAST_DOUBLE_MOVE} } = @saved_last_double_move;
  0            
1367 0           %{ $self->{CASTLE_OK} } = %saved_castle_ok;
  0            
1368 0           %{ $self->{UNDER_CHECK} } = %saved_under_check;
  0            
1369 0           $self->{RULE_50_MOVES} = $saved_rule_50_moves;
1370 0           $self->{COLOR_TO_MOVE} = $saved_color_to_move;
1371 0           $self->{FEN_MOVE_NUMBER} = $saved_move_number;
1372              
1373 0 0         if ($evaluation >= $beta) {
1374 0           return $beta;
1375             }
1376              
1377 0 0         if ($evaluation > $alphaL) {
1378 0           $alphaL = $evaluation;
1379 0 0         if ($depth == $self->{DEPTH}) {
1380 0           ${ $ref_bestmove } = $move;
  0            
1381             }
1382             }
1383             }
1384 0           return $alphaL;
1385             }
1386             }
1387             }
1388              
1389             # ENGINE METHODS
1390             sub white_move {
1391 0     0 0   my $self = shift;
1392              
1393 0           my ($evaluation, $bestmove);
1394              
1395 0 0         if ( $self->insuff_material() ) {
1396 0           print STDERR "1/2-1/2 {insufficient material}\n";
1397 0           return;
1398             }
1399 0 0         if ( $self->rule50moves() ) {
1400 0           print STDERR "1/2-1/2 {50 moves rule}\n";
1401 0           return;
1402             }
1403              
1404 0           my @legal_moves = $self->generate_legal_moves(WHITE);
1405              
1406 0 0         if (@legal_moves) {
1407 0 0         if ($self->{DEPTH} == 0) { #RANDOM MOVE
1408 0           my $nb_legal_moves = @legal_moves;
1409 0           $bestmove = $legal_moves[int(rand($nb_legal_moves))];
1410             }
1411             else {
1412 0           $evaluation = $self->alphabeta_search($self->{DEPTH}, -(AB_CNST), AB_CNST, BLACK, \$bestmove);
1413             }
1414 0           my $s_move = move_to_coord($bestmove);
1415 0           $self->execute_move($bestmove);
1416 0           print STDERR "move $s_move\n";
1417             }
1418             else {
1419 0 0         if ($self->{UNDER_CHECK}{W_K}) {
1420 0           print STDERR "0-1\n";
1421             }
1422             else {
1423 0           print STDERR "1/2-1/2 {Stalemate}\n";
1424             }
1425             }
1426             }
1427            
1428             sub black_move {
1429 0     0 0   my $self = shift;
1430              
1431 0           my ($evaluation, $bestmove);
1432              
1433 0 0         if ( $self->insuff_material() ) {
1434 0           print STDERR "1/2-1/2 {insufficient material}\n";
1435 0           return;
1436             }
1437 0 0         if ( $self->rule50moves() ) {
1438 0           print STDERR "1/2-1/2 {50 moves rule}\n";
1439 0           return;
1440             }
1441              
1442 0           my @legal_moves = $self->generate_legal_moves(BLACK);
1443              
1444 0 0         if (@legal_moves) {
1445 0 0         if ($self->{DEPTH} == 0) { #RANDOM MOVE
1446 0           my $nb_legal_moves = @legal_moves;
1447 0           $bestmove = $legal_moves[int(rand($nb_legal_moves))];
1448             }
1449             else {
1450 0           $evaluation = $self->alphabeta_search($self->{DEPTH}, -(AB_CNST), AB_CNST, WHITE, \$bestmove);
1451             }
1452              
1453 0           my $s_move = move_to_coord($bestmove);
1454 0           $self->execute_move($bestmove);
1455 0           print STDERR "move $s_move\n";
1456             }
1457             else {
1458 0 0         if ($self->{UNDER_CHECK}{B_K}) {
1459 0           print STDERR "1-0\n";
1460             }
1461             else {
1462 0           print STDERR "1/2-1/2 {Stalemate}\n";
1463             }
1464             }
1465             }
1466              
1467             sub play_one_game {
1468 0     0 0   my $self = shift;
1469              
1470 0           my ($input_move, $ok_move, $game_over, $bestmove);
1471              
1472 0           print "Please choose my color (W or B)\n";
1473 0           my $engine_color = ;
1474 0           chomp($engine_color);
1475              
1476 0   0       while (($engine_color ne "W") and ($engine_color ne "B")) {
1477 0           print "Wrong answer: Please choose my color (W or B)\n";
1478 0           $engine_color = ;
1479 0           chomp($engine_color);
1480             }
1481              
1482 0           $self->reset();
1483              
1484 0           while (1) {
1485 0 0         if ($engine_color eq "W") {
1486             # play a move
1487 0           $game_over = $self->game_over();
1488 0 0         if ($game_over) {
1489 0           print "$game_over\n";
1490 0           last;
1491             }
1492             else {
1493 0           $bestmove = $self->best_move();
1494 0           $self->execute_move(coord_to_move($bestmove));
1495              
1496 0           print "$bestmove\n";
1497             }
1498              
1499             # read user's move
1500 0           $ok_move = INVALID_MOVE;
1501 0           while ($ok_move != LEGAL_MOVE) {
1502 0           $input_move = ;
1503 0           chomp($input_move);
1504              
1505 0           $ok_move = $self->do_move($input_move);
1506 0 0         print "Invalid move\n" if ($ok_move == INVALID_MOVE);
1507 0 0         print "Illegal move\n" if ($ok_move == ILLEGAL_MOVE);
1508             }
1509             }
1510             else {
1511             # read user's move
1512 0           $ok_move = INVALID_MOVE;
1513 0           while ($ok_move != LEGAL_MOVE) {
1514 0           $input_move = ;
1515 0           chomp($input_move);
1516              
1517 0           $ok_move = $self->do_move($input_move);
1518 0 0         print "Invalid move\n" if ($ok_move == INVALID_MOVE);
1519 0 0         print "Illegal move\n" if ($ok_move == ILLEGAL_MOVE);
1520             }
1521              
1522             # play a move
1523 0           $game_over = $self->game_over();
1524 0 0         if ($game_over) {
1525 0           print "$game_over\n";
1526 0           last;
1527             }
1528             else {
1529 0           $bestmove = $self->best_move();
1530 0           $self->execute_move(coord_to_move($bestmove));
1531              
1532 0           print "$bestmove\n";
1533             }
1534             }
1535             }
1536              
1537 0           my $answer = "";
1538 0   0       while (($answer ne "Y") and ($answer ne "N")) {
1539 0           print "Another game? [Y/N]\n";
1540 0           $answer = ;
1541 0           chomp($answer);
1542             }
1543 0           return $answer;
1544             }
1545              
1546             # ------------------------- FUNCTIONS -------------------------
1547             sub sign {
1548 0     0 0   my $val = shift;
1549              
1550 0           return ($val / abs($val));
1551             }
1552              
1553             sub print_arr {
1554 0     0 0   my @arr = @_;
1555              
1556 0           foreach my $el(@arr) {
1557 0           print "$el\n";
1558             }
1559             }
1560              
1561             sub print_moves_arr {
1562 0     0 0   my @arr = @_;
1563              
1564 0           foreach my $el(@arr) {
1565 0           print move_to_coord($el) . "\n";
1566             }
1567             }
1568              
1569             sub value_to_string {
1570 0     0 0   my $value = shift;
1571              
1572 0 0         return " " if ($value == EM);
1573 0 0         return "R" if ($value == WR);
1574 0 0         return "r" if ($value == BR);
1575 0 0         return "N" if ($value == WN);
1576 0 0         return "n" if ($value == BN);
1577 0 0         return "B" if ($value == WB);
1578 0 0         return "b" if ($value == BB);
1579 0 0         return "P" if ($value == WP);
1580 0 0         return "p" if ($value == BP);
1581 0 0         return "Q" if ($value == WQ);
1582 0 0         return "q" if ($value == BQ);
1583 0 0         return "K" if ($value == WK);
1584 0 0         return "k" if ($value == BK);
1585             }
1586              
1587             sub move_to_coord {
1588 0     0 0   my $move = shift;
1589            
1590 0           my @squares = split(/ /, $move);
1591              
1592 0           my $orig_square = $squares[0];
1593 0           my $dest_square = $squares[1];
1594 0           my $promotion = "";
1595 0 0         $promotion = $squares[2] if defined($squares[2]);
1596              
1597 0           my $orig_column = ($orig_square-1) % 12;
1598 0           my $orig_raw = int (($orig_square-12) / 12);
1599 0           my $dest_column = ($dest_square-1) % 12;
1600 0           my $dest_raw = int (($dest_square-12) / 12);
1601              
1602 0           $orig_column = chr(96 + $orig_column);
1603 0           $dest_column = chr(96 + $dest_column);
1604            
1605 0           return "$orig_column$orig_raw$dest_column$dest_raw$promotion";
1606             }
1607              
1608             sub coord_to_move {
1609 0     0 0   my $coord = shift;
1610              
1611 0           my $orig_column = substr($coord, 0, 1);
1612 0           my $orig_raw = substr($coord, 1, 1);
1613 0           my $dest_column = substr($coord, 2, 1);
1614 0           my $dest_raw = substr($coord, 3, 1);
1615 0           my $promotion = "";
1616 0 0         $promotion = substr($coord, 4, 1) if (length($coord) == 5);
1617              
1618 0           $orig_column = ord($orig_column) - 96;
1619 0           $dest_column = ord($dest_column) - 96;
1620              
1621 0           my $orig_square = ($orig_raw + 1) * 12 + $orig_column + 1;
1622 0           my $dest_square = ($dest_raw + 1) * 12 + $dest_column + 1;
1623              
1624 0 0         return "$orig_square $dest_square $promotion" if ($promotion);
1625 0           return "$orig_square $dest_square";
1626             }
1627              
1628             sub print_board_debug {
1629 0     0 0   my @board = @_;
1630              
1631 0           my ($r, $c, $sq);
1632 0           for ($r = 7; $r >= 0; $r--) {
1633 0           for ($c = 0; $c <= 7; $c++) {
1634 0           $sq = 12 * ($r + 2) + 2 + $c;
1635 0           my $str = value_to_string($board[$sq]);
1636 0           print "$str ";
1637             }
1638 0           print "\n";
1639             }
1640             }
1641              
1642             sub fisher_yates_shuffle {
1643 0     0 0   my $array = shift;
1644 0           my $i = @$array;
1645 0           while ( --$i ) {
1646 0           my $j = int rand($i+1);
1647 0           @$array[$i,$j] = @$array[$j,$i];
1648             }
1649             }
1650              
1651             1;
1652              
1653             __END__