100 |
my $self = shift; |
my $self = shift; |
101 |
my $cmd = shift; |
my $cmd = shift; |
102 |
|
|
103 |
my $pid = open2(${$self->out}, ${$self->in}, $cmd); |
my $pid = open2($self->{out}, $self->{in}, $cmd); |
104 |
return $pid; |
return $pid; |
105 |
} |
} |
106 |
|
|
116 |
} else { |
} else { |
117 |
die "Illegal color $color\n"; |
die "Illegal color $color\n"; |
118 |
} |
} |
119 |
my $move = GTP::exec_cmd(${$self->in}, ${$self->out}, $cmd); |
my $move = GTP::exec_cmd($self->{in}, $self->{out}, $cmd); |
120 |
} |
} |
121 |
|
|
122 |
sub black { |
sub black { |
123 |
my $self = shift; |
my $self = shift; |
124 |
my $move = shift; |
my $move = shift; |
125 |
|
|
126 |
GTP::exec_cmd(${$self->in}, ${$self->out}, "black $move"); |
GTP::exec_cmd($self->{in}, $self->{out}, "black $move"); |
127 |
} |
} |
128 |
|
|
129 |
sub white { |
sub white { |
130 |
my $self = shift; |
my $self = shift; |
131 |
my $move = shift; |
my $move = shift; |
132 |
|
|
133 |
GTP::exec_cmd(${$self->in}, ${$self->out}, "white $move"); |
GTP::exec_cmd($self->{in}, $self->{out}, "white $move"); |
134 |
} |
} |
135 |
|
|
136 |
sub komi { |
sub komi { |
137 |
my $self = shift; |
my $self = shift; |
138 |
my $komi = shift; |
my $komi = shift; |
139 |
|
|
140 |
GTP::exec_cmd(${$self->in}, ${$self->out}, "komi $komi"); |
GTP::exec_cmd($self->{in}, $self->{out}, "komi $komi"); |
141 |
} |
} |
142 |
|
|
143 |
sub boardsize { |
sub boardsize { |
144 |
my $self = shift; |
my $self = shift; |
145 |
my $size = shift; |
my $size = shift; |
146 |
|
|
147 |
GTP::exec_cmd(${$self->in}, ${$self->out}, "boardsize $size"); |
GTP::exec_cmd($self->{in}, $self->{out}, "boardsize $size"); |
148 |
} |
} |
149 |
|
|
150 |
sub handicap { |
sub handicap { |
152 |
my $handicap = shift; |
my $handicap = shift; |
153 |
|
|
154 |
my $stones; |
my $stones; |
155 |
$stones = GTP::exec_cmd(${$self->in}, ${$self->out}, "handicap $handicap"); |
$stones = GTP::exec_cmd($self->{in}, $self->{out}, "handicap $handicap"); |
156 |
return split(' ', $stones); |
return split(' ', $stones); |
157 |
} |
} |
158 |
|
|
161 |
my $handicap = shift; |
my $handicap = shift; |
162 |
|
|
163 |
my $stones; |
my $stones; |
164 |
$stones = GTP::exec_cmd(${$self->in}, ${$self->out}, "fixed_handicap $handicap"); |
$stones = GTP::exec_cmd($self->{in}, $self->{out}, "fixed_handicap $handicap"); |
165 |
return split(' ', $stones); |
return split(' ', $stones); |
166 |
} |
} |
167 |
|
|
168 |
sub quit { |
sub quit { |
169 |
my $self = shift; |
my $self = shift; |
170 |
|
|
171 |
$self->in->print("quit\n"); |
$self->{in}->print("quit\n"); |
172 |
} |
} |
173 |
|
|
174 |
sub showboard { |
sub showboard { |
175 |
my $self = shift; |
my $self = shift; |
176 |
|
|
177 |
GTP::exec_cmd(${$self->in}, ${$self->out}, "showboard"); |
GTP::exec_cmd($self->{in}, $self->{out}, "showboard"); |
178 |
} |
} |
179 |
|
|
180 |
sub get_random_seed { |
sub get_random_seed { |
181 |
my $self = shift; |
my $self = shift; |
182 |
|
|
183 |
my $ret = GTP::exec_cmd(${$self->in}, ${$self->out}, "get_random_seed"); |
my $ret = GTP::exec_cmd($self->{in}, $self->{out}, "get_random_seed"); |
184 |
if ($ret eq "ERROR") { |
if ($ret eq "ERROR") { |
185 |
return "unknown"; |
return "unknown"; |
186 |
} |
} |
191 |
sub get_program_name { |
sub get_program_name { |
192 |
my $self = shift; |
my $self = shift; |
193 |
|
|
194 |
my $name = GTP::exec_cmd(${$self->in}, ${$self->out}, "name"); |
my $name = GTP::exec_cmd($self->{in}, $self->{out}, "name"); |
195 |
my $version = GTP::exec_cmd(${$self->in}, ${$self->out}, "version"); |
my $version = GTP::exec_cmd($self->{in}, $self->{out}, "version"); |
196 |
return "$name $version"; |
return "$name $version"; |
197 |
} |
} |
198 |
|
|
199 |
sub score { |
sub score { |
200 |
my $self = shift; |
my $self = shift; |
201 |
|
|
202 |
return GTP::exec_cmd(${$self->in}, ${$self->out}, "score"); |
return GTP::exec_cmd($self->{in}, $self->{out}, "score"); |
203 |
} |
} |
204 |
|
|
205 |
sub estimate_score { |
sub estimate_score { |
206 |
my $self = shift; |
my $self = shift; |
207 |
|
|
208 |
my $ret = GTP::exec_cmd(${$self->in}, ${$self->out}, "estimate_score"); |
my $ret = GTP::exec_cmd($self->{in}, $self->{out}, "estimate_score"); |
209 |
my ($result, $rest) = split(' ', $ret, 2); |
my ($result, $rest) = split(' ', $ret, 2); |
210 |
return $result; |
return $result; |
211 |
} |
} |
264 |
my $white_seed = $self->white->get_random_seed; |
my $white_seed = $self->white->get_random_seed; |
265 |
my $handicap = $self->handicap; |
my $handicap = $self->handicap; |
266 |
my $komi = $self->komi; |
my $komi = $self->komi; |
267 |
my $result = $self->result->resultw; |
my $result = $self->{result}->resultw; |
268 |
|
|
269 |
print $handle "(;GM[1]FF[4]RU[Japanese]SZ[$size]HA[$handicap]KM[$komi]RE[$result]\n"; |
print $handle "(;GM[1]FF[4]RU[Japanese]SZ[$size]HA[$handicap]KM[$komi]RE[$result]\n"; |
270 |
print $handle "PW[$white_name (random seed $white_seed)]PB[$black_name (random seed $black_seed)]\n"; |
print $handle "PW[$white_name (random seed $white_seed)]PB[$black_name (random seed $black_seed)]\n"; |
396 |
print "Result according to W: $resultw\n"; |
print "Result according to W: $resultw\n"; |
397 |
print "****** according to B: $resultb\n"; |
print "****** according to B: $resultb\n"; |
398 |
} |
} |
399 |
$self->result->resultw($resultw); |
$self->{result} = new GTP::Game::Result; |
400 |
$self->result->resultb($resultb); |
$self->{result}->resultw($resultw); |
401 |
|
$self->{result}->resultb($resultb); |
402 |
$self->writesgf($sgffile) if defined $sgffile; |
$self->writesgf($sgffile) if defined $sgffile; |
403 |
} |
} |
404 |
|
|
435 |
my $sgffile_game = sprintf "%s%03d.sgf", $sgffile_base, $i; |
my $sgffile_game = sprintf "%s%03d.sgf", $sgffile_base, $i; |
436 |
$game->play($sgffile_game); |
$game->play($sgffile_game); |
437 |
my $result = new GTP::Game::Result; |
my $result = new GTP::Game::Result; |
438 |
$result->resultb($game->result->resultb); |
$result->resultb($game->{result}->resultb); |
439 |
$result->resultw($game->result->resultw); |
$result->resultw($game->{result}->resultw); |
440 |
push @results, $result; |
push @results, $result; |
441 |
} |
} |
442 |
return @results; |
return @results; |