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__ |