[ViewVC] Diff of: cvs/Games-Go-SimpleBoard/SimpleBoard.pm

Comparing Games-Go-SimpleBoard/SimpleBoard.pm (file contents):
Revision 1.1 by root, Sun Jun 22 15:05:59 2008 UTC vs.
Revision 1.13 by elmex, Thu Jul 24 08:50:53 2008 UTC

…		…
17	Marker types for each board position (ORed together):	17	Marker types for each board position (ORed together):
18		18
19	MARK_TRIANGLE # triangle mark	19	MARK_TRIANGLE # triangle mark
20	MARK_SQUARE # square mark	20	MARK_SQUARE # square mark
21	MARK_CIRCLE # circle mark	21	MARK_CIRCLE # circle mark
		22	MARK_CROSS # cross mark
22	MARK_SMALL_B # small stone, used for scoring or marking	23	MARK_SMALL_B # small stone, used for scoring or marking
23	MARK_SMALL_W # small stone, used for scoring or marking	24	MARK_SMALL_W # small stone, used for scoring or marking
24	MARK_B # normal black stone	25	MARK_B # normal black stone
25	MARK_W # normal whit stone	26	MARK_W # normal whit stone
26	MARK_GRAYED # in conjunction with MARK_[BW], grays the stone	27	MARK_GRAYED # in conjunction with MARK_[BW], grays the stone
…		…
28	MARK_HOSHI # this is a hoshi point (not used much)	29	MARK_HOSHI # this is a hoshi point (not used much)
29	MARK_MOVE # this is a regular move	30	MARK_MOVE # this is a regular move
30	MARK_KO # this is a ko position	31	MARK_KO # this is a ko position
31	MARK_REDRAW # ignored, can be used for your own purposes	32	MARK_REDRAW # ignored, can be used for your own purposes
32		33
33	COLOUR_BLACK # used for $board->{last}	34	COLOUR_WHITE # guarenteed to be 0
34	COLOUR_WHITE # to mark the colour of the last move	35	COLOUR_BLACK # guarenteed to be 1
		36
		37	MOVE_HANDICAP # used as "x-coordinate" for handicap moves
		38	MOVE_PASS # can be used as "x-coordinate" for pass moves
35		39
36	=head2 METHODS	40	=head2 METHODS
37		41
38	=over 4	42	=over 4
39		43
40	=cut	44	=cut
41		45
		46	no warnings;
		47	use strict;
		48
		49	use Carp ();
		50
42	use base Exporter;	51	use base Exporter::;
43		52
44	our $VERSION = '1.0';	53	our $VERSION = '1.0';
45		54
46	@EXPORT = qw(	55	our @EXPORT = qw(
47	MARK_TRIANGLE MARK_SQUARE MARK_CIRCLE MARK_SMALL_B MARK_SMALL_W MARK_B	56	MARK_TRIANGLE MARK_SQUARE MARK_CIRCLE MARK_SMALL_B MARK_SMALL_W MARK_B
48	MARK_W MARK_GRAYED MARK_MOVE MARK_LABEL MARK_HOSHI MARK_KO	57	MARK_W MARK_GRAYED MARK_MOVE MARK_LABEL MARK_HOSHI MARK_KO MARK_CROSS
49	MARK_REDRAW	58	MARK_REDRAW
50	COLOUR_BLACK COLOUR_WHITE	59	COLOUR_BLACK COLOUR_WHITE
		60	MOVE_HANDICAP MOVE_PASS
51	);	61	);
52		62
53	# marker types for each board position (ORed together)	63	# marker types for each board position (ORed together)
54		64
55	sub MARK_TRIANGLE (){ 0x0001 }	65	sub MARK_TRIANGLE (){ 0x0001 }
…		…
62	sub MARK_GRAYED (){ 0x0080 } # in conjunction with MARK_[BW], grays the stone	72	sub MARK_GRAYED (){ 0x0080 } # in conjunction with MARK_[BW], grays the stone
63	sub MARK_LABEL (){ 0x0100 }	73	sub MARK_LABEL (){ 0x0100 }
64	sub MARK_HOSHI (){ 0x0200 } # this is a hoshi point (not used much)	74	sub MARK_HOSHI (){ 0x0200 } # this is a hoshi point (not used much)
65	sub MARK_MOVE (){ 0x0400 } # this is a regular move	75	sub MARK_MOVE (){ 0x0400 } # this is a regular move
66	sub MARK_KO (){ 0x0800 } # this is a ko position	76	sub MARK_KO (){ 0x0800 } # this is a ko position
		77	sub MARK_CROSS (){ 0x1000 }
67	sub MARK_REDRAW (){ 0x8000 }	78	sub MARK_REDRAW (){ 0x8000 }
68		79
69	sub COLOUR_BLACK (){ 0 }
70	sub COLOUR_WHITE (){ 1 }	80	sub COLOUR_WHITE (){ 0 }
		81	sub COLOUR_BLACK (){ 1 }
		82
		83	sub MOVE_PASS (){ undef }
		84	sub MOVE_HANDICAP (){ -2 }
71		85
72	=item my $board = new $size	86	=item my $board = new $size
73		87
74	Creates a new empty board of the given size.	88	Creates a new empty board of the given size.
75		89
		90	C<< $board->{size} >> stores the board size.
		91
76	C<< $board->{max} >> stores the maximum board coordinate (size-1).	92	C<< $board->{max} >> stores the maximum board coordinate (size-1).
77		93
78	C<< $board->{captures}[COLOUR] >> stores the number of captured stones for	94	C<< $board->{captures}[COLOUR_xxx] >> stores the number of captured stones for
79	the given colour.	95	the given colour.
80
81	C<< $board->{last} >> stores the colour of the last move that was played.
82		96
83	C<< $board->{board} >> stores a two-dimensional array with board contents.	97	C<< $board->{board} >> stores a two-dimensional array with board contents.
84		98
85	=cut	99	=cut
86		100
87	sub new {	101	sub new {
88	my $class = shift;	102	my $class = shift;
89	my $size = shift;	103	my $size = shift;
		104
		105	unless ($size > 0) {
		106	Carp::croak ("no board size given!");
		107	}
		108
90	bless {	109	bless {
91	max => $size - 1,	110	max => $size - 1,
		111	size => $size,
92	board => [map [(0) x $size], 1 .. $size],	112	board => [map [(0) x $size], 1 .. $size],
93	captures => [0, 0], # captures	113	captures => [0, 0], # captures
94	#timer => [],	114	#timer => [],
95	#score => [],	115	#score => [],
96	#last => COLOUR_...,
97	@_
98	},	116	@_,
99	$class;	117	}, $class
100	}	118	}
101		119
102	# inefficient and primitive, I hear you say?	120	# inefficient and primitive, I hear you say?
103	# well... you are right :)	121	# well... you are right :)
104	# use an extremely dumb floodfill algorithm to get rid of captured stones	122	# use an extremely dumb floodfill algorithm to get rid of captured stones
…		…
129	}	147	}
130		148
131	@found	149	@found
132	}	150	}
133		151
134	=item $hint = $board->update ([update-structure...])	152	=item $hint = $board->update ([update-structures...])
135		153
136	Structure is	154	Each update-structure itself is also an array-ref:
137		155
138	[$x, $y, $clr, $set, $label, $hint] # update or move	156	[$x, $y, $clr, $set, $label, $hint] # update or move
		157	[MOVE_HANDICAP, $handicap] # black move, setup handicap
		158	[MOVE_PASS] # pass
139	[] # pass	159	[] # also pass (deprecated!)
140		160
141	and changes the board or executes a move, by first clearing the bits	161	It changes the board or executes a move, by first clearing the bits
142	specified in C<$clr>, then setting bits specified in C<$set>.	162	specified in C<$clr>, then setting bits specified in C<$set>.
143		163
144	If C<$set> includes C<MARK_LABEL>, the label text must be given in	164	If C<$set> includes C<MARK_LABEL>, the label text must be given in
145	C<$label>.	165	C<$label>.
146		166
		167	If C<$set> contains C<MARK_MOVE> then surrounded stones will be removed
		168	from the board and (simple) Kos are detected and marked with square
		169	symbols and C<MARK_KO>, after removing other marking symbols. The
		170	markings are also removed with the next next update structure that uses
		171	C<MARK_MOVE>, so this flag is suited well for marking, well, moves. Note
		172	that you can make invalid "moves" (such as suicide) and C<update> will
		173	try to cope with it. You can use C<is_valid_move> to avoid making illegal
		174	moves.
		175
		176	For handicap "moves", currently only board sizes 9, 13 and 19 are
		177	supported and only handicap values from 2 to 9. The placement follows the
		178	IGS rules, if you want other placements, you have to set it up yourself.
		179
147	This function modifies the hint member of the specified path to speed up	180	This function modifies the C<$hint> member of the specified structure
148	repeated board generation and updates with the same update structures.	181	to speed up repeated board generation and updates with the same update
		182	structures.
149		183
150	If the hint member is a reference the scalar pointed to by the reference	184	If the hint member is a reference the scalar pointed to by the reference
151	is updated instead.	185	is updated instead.
152		186
		187	If all this hint member thing is confusing, just ignore it and specify
		188	it as C<undef> or leave it out of the array entirely. Do make sure that
		189	you keep your update structures around as long as previous updates don't
		190	change, however, as regenerating a full board position from hinted
		191	update structures is I<much> faster then recreating it from fresh update
		192	structures.
		193
153	Example, make two silly moves:	194	Example, make two silly moves:
154		195
155	$board->update ([[0, 18, -1, MARK_B\|MARK_MOVE],	196	$board->update ([[0, 18, -1, MARK_B \| MARK_MOVE],
156	[0, 17, -1, MARK_W\|MARK_MOVE]);	197	[0, 17, -1, MARK_W \| MARK_MOVE]]);
157		198
158	=cut	199	=cut
		200
		201	our %HANDICAP_COORD = (
		202	9 => [2, 4, 6],
		203	13 => [3, 6, 9],
		204	19 => [3, 9, 15],
		205	);
		206	our %HANDICAP_XY = (
		207	2 => [qw(0,2 2,0 )],
		208	3 => [qw(0,2 2,0 0,0 )],
		209	4 => [qw(0,2 2,0 0,0 2,2 )],
		210	5 => [qw(0,2 2,0 0,0 2,2 1,1)],
		211	6 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 )],
		212	7 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,1)],
		213	8 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,0 1,2 )],
		214	9 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,0 1,2 1,1)],
		215	);
		216
		217	our $mark_symbols = MARK_CIRCLE \| MARK_SQUARE \| MARK_TRIANGLE \| MARK_CROSS \| MARK_KO;
159		218
160	sub update {	219	sub update {
161	my ($self, $path) = @_;	220	my ($self, $path) = @_;
162		221
163	my $board = $self->{board};	222	my $board = $self->{board};
164		223
165	for (@$path) {	224	for (@$path) {
166	my ($x, $y, $clr, $set, $label) = @$_;	225	my ($x, $y, $clr, $set, $label) = @$_;
167		226
168	my $nodemask =
169	$_ == $path->[-1]
170	? ~0
171	: ~(MARK_SQUARE \| MARK_TRIANGLE \| MARK_CIRCLE \| MARK_LABEL \| MARK_KO);
172
173	if (defined $x) {	227	if (!defined $x) {
		228	$$_ &= ~$mark_symbols for @{ delete $self->{unmark} \|\| [] };
		229	# pass
		230
		231	} elsif ($x == MOVE_HANDICAP) {
		232	$$_ &= ~$mark_symbols for @{ delete $self->{unmark} \|\| [] };
		233
		234	# $y = #handicap stones
		235	my $c = $HANDICAP_COORD{$self->{size}}
		236	or Carp::croak "$self->{size}: illegal board size for handicap";
		237	my $h = $HANDICAP_XY{$y}
		238	or Carp::croak "$y: illegal number of handicap stones";
		239
		240	for (@$h) {
		241	my ($x, $y) = map $c->[$_], split /,/;
		242	$board->[$x][$y] = MARK_B \| MARK_MOVE;
		243	}
		244
		245	} else {
174	$board->[$x][$y] =	246	my $space = \$board->[$x][$y];
175	$board->[$x][$y]	247
176	& ~$clr	248	$$space = $$space & ~$clr \| $set;
177	\| $set
178	& $nodemask;
179		249
180	$self->{label}[$x][$y] = $label if $set & MARK_LABEL;	250	$self->{label}[$x][$y] = $label if $set & MARK_LABEL;
181		251
182	if ($set & MARK_MOVE) {	252	if ($set & MARK_MOVE) {
183	$self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE;	253	$$_ &= ~$mark_symbols for @{ $self->{unmark} \|\| [] };
		254	@{ $self->{unmark} } = $space;
184		255
185	unless (${ $_->[5] \|\|= \my $hint }) {	256	unless (${ $_->[5] \|\|= \my $hint }) {
186	my ($own, $opp) =	257	my ($own, $opp) =
187	$set & MARK_B	258	$set & MARK_B
188	? (MARK_B, MARK_W)	259	? (MARK_B, MARK_W)
…		…
197		268
198	# keep only unique coordinates	269	# keep only unique coordinates
199	@capture = do { my %seen; grep !$seen{"$_->[0],$_->[1]"}++, @capture };	270	@capture = do { my %seen; grep !$seen{"$_->[0],$_->[1]"}++, @capture };
200		271
201	# remove captured stones	272	# remove captured stones
202	$self->{captures}[$self->{last}] += @capture;	273	$self->{captures}[$own == MARK_B ? COLOUR_BLACK : COLOUR_WHITE] += @capture;
203	$self->{board}[$_->[0]][$_->[1]] &= ~(MARK_B \| MARK_W \| MARK_MOVE)	274	$self->{board}[$_->[0]][$_->[1]] = 0
204	for @capture;	275	for @capture;
205		276
206	$suicide += $self->capture ($own, $x, $y);	277	$suicide += $self->capture ($own, $x, $y);
207		278
208	${ $_->[5] } \|\|= !(@capture \|\| $suicide);	279	${ $_->[5] } \|\|= !(@capture \|\| $suicide);
209		280
		281	if ($suicide) {
		282	$self->{board}[$x][$y] = 0
		283
210	if (!$suicide && @capture == 1) {	284	} elsif (!$suicide && @capture == 1) {
211	# possible ko. now check liberties on placed stone	285	# possible ko. now check liberties on placed stone
212		286
213	my $libs;	287	my $libs;
214		288
215	$libs++ if $x > 0 && !($board->[$x-1][$y] & $opp);	289	$libs++ if $x > 0 && !($board->[$x-1][$y] & $opp);
216	$libs++ if $x < $self->{max} && !($board->[$x+1][$y] & $opp);	290	$libs++ if $x < $self->{max} && !($board->[$x+1][$y] & $opp);
217	$libs++ if $y > 0 && !($board->[$x][$y-1] & $opp);	291	$libs++ if $y > 0 && !($board->[$x][$y-1] & $opp);
218	$libs++ if $y < $self->{max} && !($board->[$x][$y+1] & $opp);	292	$libs++ if $y < $self->{max} && !($board->[$x][$y+1] & $opp);
219		293
220	if ($libs == 1) {	294	if ($libs == 1) {
221	$board->[$x][$y] = $board->[$x][$y] & ~MARK_CIRCLE \| (MARK_KO & $nodemask);	295	$$space = $$space & ~$mark_symbols \| MARK_KO;
		296
222	($x, $y) = @{$capture[0]};	297	($x, $y) = @{$capture[0]};
223	$board->[$x][$y] \|= MARK_KO & $nodemask;	298	$board->[$x][$y] \|= MARK_KO;
		299
		300	push @{ $self->{unmark} }, \$board->[$x][$y];
224	}	301	}
225	}	302	}
226	}	303	}
227	}	304	}
228	} else {
229	$self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE;
230	}	305	}
231	}	306	}
232	}	307	}
233		308
234	=item $board->is_valid_move ($colour, $x, $y[, $may_suicide])	309	=item $board->is_valid_move ($colour, $x, $y[, $may_suicide])
235		310
236	Returns true if the move of the given colour on the given coordinates is	311	Returns true if the move of the given colour on the given coordinates is
237	valid or not.	312	valid or not. Kos are taken into account as long as they are marked with
		313	C<MARK_KO>. Suicides are invalid unless C<$may_suicide> is true (e.g. for
		314	new zealand rules)
238		315
239	=cut	316	=cut
240		317
241	sub is_valid_move {	318	sub is_valid_move {
242	my ($self, $colour, $x, $y, $may_suicide) = @_;	319	my ($self, $colour, $x, $y, $may_suicide) = @_;
243		320
244	my $board = $self->{board};	321	my $board = $self->{board};
245		322
246	return if $board->[$x][$y] & (MARK_B \| MARK_W \| MARK_KO);	323	return if $board->[$x][$y] & (MARK_B \| MARK_W \| MARK_KO)
		324	&& !($board->[$x][$y] & MARK_GRAYED);
247		325
248	if ($may_suicide) {	326	if ($may_suicide) {
249	return 1;	327	return 1;
250	} else {	328	} else {
251	my ($own, $opp) = $colour == COLOUR_BLACK	329	my ($own, $opp) = $colour == COLOUR_BLACK
…		…
272		350
273	Marc Lehmann <schmorp@schmorp.de>	351	Marc Lehmann <schmorp@schmorp.de>
274		352
275	=head2 SEE ALSO	353	=head2 SEE ALSO
276		354
277	L<KGS::Protocol>, L<KGS::Game::Tree>, L<Gtk2::GoBoard>.	355	L<Gtk2::GoBoard>.
278		356
279	=cut	357	=cut
280		358

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing Games-Go-SimpleBoard/SimpleBoard.pm (file contents): Revision 1.1 by root, Sun Jun 22 15:05:59 2008 UTC vs. Revision 1.13 by elmex, Thu Jul 24 08:50:53 2008 UTC

Diff Legend

Comparing Games-Go-SimpleBoard/SimpleBoard.pm (file contents):
Revision 1.1 by root, Sun Jun 22 15:05:59 2008 UTC vs.
Revision 1.13 by elmex, Thu Jul 24 08:50:53 2008 UTC