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