1#!/usr/bin/perl -w 2 3# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 4# This program is distributed with GNU Go, a Go program. # 5# # 6# Write gnugo@gnu.org or see http://www.gnu.org/software/gnugo/ # 7# for more information. # 8# # 9# Copyright 1999, 2000, 2001 by the Free Software Foundation. # 10# # 11# This program is free software; you can redistribute it and/or # 12# modify it under the terms of the GNU General Public License # 13# as published by the Free Software Foundation - version 3, # 14# or (at your option) any later version. # 15# # 16# This program is distributed in the hope that it will be # 17# useful, but WITHOUT ANY WARRANTY; without even the implied # 18# warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR # 19# PURPOSE. See the GNU General Public License in file COPYING # 20# for more details. # 21# # 22# You should have received a copy of the GNU General Public # 23# License along with this program; if not, write to the Free # 24# Software Foundation, Inc., 51 Franklin Street, Fifth Floor, # 25# Boston, MA 02111, USA. # 26# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 27 28package ttgo; 29require Exporter; 30 31use strict; 32 33 34our @ISA = qw(Exporter); 35our @EXPORT = qw(ttNewGame ttShowBoard ttPlaceStone ttGetBoard ttScore); 36 37my @bd = (); 38my @sbd = (); # working board 39my $white = 1; 40my $black = 2; 41my $bs; 42my @letter = qw ( A B C D E F G H J K L M N O P Q R S T U V W X Y Z ); 43my %tocol = ( 'b' => 2, 'B' => 2, 'w' => 1, 'W' => 1 ); 44my %toix = (); 45foreach my $ix (0 .. $#letter) { 46 $toix{ $letter[$ix] } = $ix; 47} 48 49my %hashed_boards = (); # for convenient rep testing 50my @all_boards = (); # for move takebacks 51 52 53my %tovisual = ( 2 => 'W', 1 => 'B', 0 => '+' ); 54 55my @dir = (); 56 57 58 59sub ttNewGame 60{ 61 ($bs) = @_; 62 63 my $s = ($bs+2) * ($bs+1); 64 65 foreach my $i (0 .. $s-1) { 66 $bd[$i] = 3; # w+b 67 } 68 69 foreach my $x (0 .. $bs - 1) { 70 foreach my $y (0 .. $bs - 1) { 71 $bd[ ($y+1) * ($bs+1) + $x ] = 0; # empty 72 } 73 } 74 75 @dir = (); 76 77 $dir[0] = -1; 78 $dir[1] = 1; 79 $dir[2] = $bs + 1; 80 $dir[3] = -($bs + 1); 81 82 push( @all_boards, join(',', @bd) ); 83} 84 85 86 87sub ttPlaceStone 88{ 89 my ($c, $loc) = @_; 90 91 my @prev_board = @bd; # to take back if needed 92 $hashed_boards{join(',',@prev_board)} = 1; # hash previous board 93 94 if ($loc eq 'PASS') { 95 return(0); 96 } 97 98 $loc =~ /^(.)(.*)/; 99 my $y = $bs - $2; 100 my $x = $toix{$1}; 101 102 my $sq = ($y+1) * ($bs+1) + $x; 103 104 105 # occupied? 106 # ========= 107 if ($bd[ ($y+1) * ($bs+1) + $x ] != 0) { 108 print "Illegal move, square occupied\n"; 109 return(1); 110 } 111 112 # Make move 113 # ========= 114 $bd[$sq] = $tocol{$c}; 115 116 # did we capture anything? 117 # ======================== 118 my $cc = $tocol{$c}; # current color 119 my $cap = 0; 120 foreach my $d (@dir) { 121 if ($bd[$sq+$d] == (3 ^ $cc)) { 122 @sbd = @bd; 123 my $lc = lib_count( 3 ^ $cc, $sq + $d ); 124 if ($lc == 0) { 125 $cap = 1; 126 print "Capture possible\n"; 127 capture( 3 ^ $cc, $sq+$d ); 128 } 129 } 130 } 131 132 # if capture not possible, it might be suicide 133 # ============================================ 134 135 if (!$cap) { 136 $bd[$sq] = 0; # make it empty again 137 @sbd = @bd; 138 $sbd[$sq] = $tocol{$c}; 139 my $lc = lib_count($tocol{$c}, $sq ); 140 print "liberty count = $lc\n"; 141 if ($lc == 0) { 142 print "Illegal move, suicide!\n"; 143 return(2); 144 } 145 # Make move 146 # ========= 147 $bd[$sq] = $tocol{$c}; 148 } 149 150 151 if ( defined( $hashed_boards{ join(',',@bd) } ) ) { 152 print "Illegal move, repeated positions\n"; 153 # @bd = @prev_board; 154 # return(0); 155 } 156 157 push( @all_boards, join(',', @bd) ); 158 159 ttScore(); 160 161 return 0; 162} 163 164 165 166 167sub lib_count 168{ 169 my ($c, $sq) = @_; 170 my $count = 0; 171 172 foreach my $d (@dir) { 173 if ($sbd[ $sq + $d ] == 0) { 174 $count++; 175 $sbd[$sq + $d ] = 9; 176 next; 177 } 178 if ($sbd[ $sq + $d ] == 3) { next; } 179 if ($sbd[ $sq + $d ] == $c) { 180 $sbd[$sq + $d ] = 9; 181 $count += lib_count( $c, $sq + $d ); 182 } 183 } 184 185 return $count; 186} 187 188 189sub capture 190{ 191 my ($c, $sq) = @_; 192 193 $bd[$sq] = 0; 194 foreach my $d (@dir) { 195 if ( $bd[ $sq + $d ] == $c ) { 196 capture( $c, $sq + $d ); 197 } 198 } 199} 200 201 202 203sub ttShowBoard 204{ 205 foreach my $y (0 .. $bs + 1) { 206 foreach my $x (0 .. $bs) { 207 printf ( "%2d", $bd[ $y * ($bs+1) + $x ] ); 208 } 209 print "\n"; 210 } 211 212 print "\n"; 213} 214 215 216 217sub ttGetBoard 218{ 219 my @tbd = (); 220 221 foreach my $y (0 .. $bs-1) { 222 foreach my $x (0 .. $bs-1) { 223 push @tbd, $tovisual{ $bd[ ($y+1) * ($bs+1) + $x ] }; 224 } 225 } 226 return @tbd; 227} 228 229 230 231sub ttScore 232{ 233 @sbd = @bd; 234 235 my $who = 0; 236 my @ter = (0, 0, 0); 237 my @stc = (0, 0, 0); 238 239 foreach my $sq (0 .. (($bs+2) * ($bs+1))-1 ) { 240 if ( $bd[$sq]==1 || $bd[$sq]==2 ) { $stc[$bd[$sq]] ++; } 241 if ($sbd[$sq] == 0) { 242 my ($cnt, $who) = count_space($sq); 243 if ($who == 1 || $who == 2) { 244 $ter[$who] += $cnt; 245 } 246 } 247 } 248 249 print "white stones=$stc[$white] territory=$ter[$white]\n"; 250 print "black stones=$stc[$black] territory=$ter[$black]\n"; 251 252 return( ($stc[$black] + $ter[$black])-($stc[$white] + $ter[$white]) ); 253} 254 255 256 257 258# return count 259# ------------ 260sub count_space 261{ 262 my ($sq) = @_; 263 my $count = 0; 264 my $who = 0; 265 266 if ( $sbd[$sq] == 9 || $sbd[$sq] == 3) { 267 return (0,0); 268 } elsif ( $sbd[$sq] != 0 ) { 269 $who |= $sbd[$sq]; 270 return( 0, $who); 271 } else { # must be zero 272 $count++; 273 $sbd[$sq] = 9; # mark it 274 foreach my $d (@dir) { 275 my ($c, $w) = count_space( $sq + $d ); 276 $count += $c; 277 $who |= $w; 278 } 279 } 280 return ( $count, $who ); 281} 282 283 2841; 285 286 287 288 289 290