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

Comparing Games-Go-SimpleBoard/SimpleBoard.pm (file contents):
Revision 1.2 by root, Mon Jun 23 00:38:35 2008 UTC vs.
Revision 1.10 by root, Wed Jun 25 20:49:38 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
90	bless {	105	bless {
91	max => $size - 1,	106	max => $size - 1,
		107	size => $size,
92	board => [map [(0) x $size], 1 .. $size],	108	board => [map [(0) x $size], 1 .. $size],
93	captures => [0, 0], # captures	109	captures => [0, 0], # captures
94	#timer => [],	110	#timer => [],
95	#score => [],	111	#score => [],
96	#last => COLOUR_...,
97	@_
98	},	112	@_,
99	$class;	113	}, $class
100	}	114	}
101		115
102	# inefficient and primitive, I hear you say?	116	# inefficient and primitive, I hear you say?
103	# well... you are right :)	117	# well... you are right :)
104	# use an extremely dumb floodfill algorithm to get rid of captured stones	118	# use an extremely dumb floodfill algorithm to get rid of captured stones
…		…
134	=item $hint = $board->update ([update-structures...])	148	=item $hint = $board->update ([update-structures...])
135		149
136	Each update-structure itself is also an array-ref:	150	Each update-structure itself is also an array-ref:
137		151
138	[$x, $y, $clr, $set, $label, $hint] # update or move	152	[$x, $y, $clr, $set, $label, $hint] # update or move
		153	[MOVE_HANDICAP, $handicap] # black move, setup handicap
		154	[MOVE_PASS] # pass
139	[] # pass	155	[] # also pass (deprecated!)
140		156
141	It changes the board or executes a move, by first clearing the bits	157	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>.	158	specified in C<$clr>, then setting bits specified in C<$set>.
143		159
144	If C<$set> includes C<MARK_LABEL>, the label text must be given in	160	If C<$set> includes C<MARK_LABEL>, the label text must be given in
145	C<$label>.	161	C<$label>.
146		162
		163	If C<$set> contains C<MARK_MOVE> then surrounded stones will be removed
		164	from the board and (simple) Kos are detected and marked with square
		165	symbols and C<MARK_KO>, after removing other marking symbols. The
		166	markings are also removed with the next next update structure that uses
		167	C<MARK_MOVE>, so this flag is suited well for marking, well, moves. Note
		168	that you can make invalid "moves" (such as suicide) and C<update> will
		169	try to cope with it. You can use C<is_valid_move> to avoid making illegal
		170	moves.
		171
		172	For handicap "moves", currently only board sizes 9, 13 and 19 are
		173	supported and only handicap values from 2 to 9. The placement follows the
		174	IGS rules, if you want other placements, you have to set it up yourself.
		175
147	This function modifies the hint member of the specified path to speed up	176	This function modifies the C<$hint> member of the specified structure
148	repeated board generation and updates with the same update structures.	177	to speed up repeated board generation and updates with the same update
		178	structures.
149		179
150	If the hint member is a reference the scalar pointed to by the reference	180	If the hint member is a reference the scalar pointed to by the reference
151	is updated instead.	181	is updated instead.
152		182
153	If all this hint member thing is unclear, just ignore it and specify it	183	If all this hint member thing is confusing, just ignore it and specify
154	as C<undef> or leave it out of the array entirely. Do make sure that you	184	it as C<undef> or leave it out of the array entirely. Do make sure that
155	keep your update structures around, however, as regenerating a full board	185	you keep your update structures around as long as previous updates don't
156	position from hinted update structures is I<much> faster then recreating	186	change, however, as regenerating a full board position from hinted
157	it from fresh update structures.	187	update structures is I<much> faster then recreating it from fresh update
		188	structures.
158		189
159	Example, make two silly moves:	190	Example, make two silly moves:
160		191
161	$board->update ([[0, 18, -1, MARK_B\|MARK_MOVE],	192	$board->update ([[0, 18, -1, MARK_B \| MARK_MOVE],
162	[0, 17, -1, MARK_W\|MARK_MOVE]);	193	[0, 17, -1, MARK_W \| MARK_MOVE]]);
163		194
164	=cut	195	=cut
		196
		197	our %HANDICAP_COORD = (
		198	9 => [2, 4, 6],
		199	13 => [3, 6, 9],
		200	19 => [3, 9, 15],
		201	);
		202	our %HANDICAP_XY = (
		203	2 => [qw(0,2 2,0 )],
		204	3 => [qw(0,2 2,0 0,0 )],
		205	4 => [qw(0,2 2,0 0,0 2,2 )],
		206	5 => [qw(0,2 2,0 0,0 2,2 1,1)],
		207	6 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 )],
		208	7 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,1)],
		209	8 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,0 1,2 )],
		210	9 => [qw(0,2 2,0 0,0 2,2 0,1 2,1 1,0 1,2 1,1)],
		211	);
		212
		213	our $mark_symbols = MARK_CIRCLE \| MARK_SQUARE \| MARK_TRIANGLE \| MARK_CROSS \| MARK_KO;
165		214
166	sub update {	215	sub update {
167	my ($self, $path) = @_;	216	my ($self, $path) = @_;
168		217
169	my $board = $self->{board};	218	my $board = $self->{board};
170		219
171	for (@$path) {	220	for (@$path) {
172	my ($x, $y, $clr, $set, $label) = @$_;	221	my ($x, $y, $clr, $set, $label) = @$_;
173		222
174	my $nodemask =
175	$_ == $path->[-1]
176	? ~0
177	: ~(MARK_SQUARE \| MARK_TRIANGLE \| MARK_CIRCLE \| MARK_LABEL \| MARK_KO);
178
179	if (defined $x) {	223	if (!defined $x) {
		224	$$_ &= ~$mark_symbols for @{ delete $self->{unmark} \|\| [] };
		225	# pass
		226
		227	} elsif ($x == MOVE_HANDICAP) {
		228	$$_ &= ~$mark_symbols for @{ delete $self->{unmark} \|\| [] };
		229
		230	# $y = #handicap stones
		231	my $c = $HANDICAP_COORD{$self->{size}}
		232	or Carp::croak "$self->{size}: illegal board size for handicap";
		233	my $h = $HANDICAP_XY{$y}
		234	or Carp::croak "$y: illegal number of handicap stones";
		235
		236	for (@$h) {
		237	my ($x, $y) = map $c->[$_], split /,/;
		238	$board->[$x][$y] = MARK_B \| MARK_MOVE;
		239	}
		240
		241	} else {
180	$board->[$x][$y] =	242	my $space = \$board->[$x][$y];
181	$board->[$x][$y]	243
182	& ~$clr	244	$$space = $$space & ~$clr \| $set;
183	\| $set
184	& $nodemask;
185		245
186	$self->{label}[$x][$y] = $label if $set & MARK_LABEL;	246	$self->{label}[$x][$y] = $label if $set & MARK_LABEL;
187		247
188	if ($set & MARK_MOVE) {	248	if ($set & MARK_MOVE) {
189	$self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE;	249	$$_ &= ~$mark_symbols for @{ $self->{unmark} \|\| [] };
		250	@{ $self->{unmark} } = $space;
190		251
191	unless (${ $_->[5] \|\|= \my $hint }) {	252	unless (${ $_->[5] \|\|= \my $hint }) {
192	my ($own, $opp) =	253	my ($own, $opp) =
193	$set & MARK_B	254	$set & MARK_B
194	? (MARK_B, MARK_W)	255	? (MARK_B, MARK_W)
…		…
203		264
204	# keep only unique coordinates	265	# keep only unique coordinates
205	@capture = do { my %seen; grep !$seen{"$_->[0],$_->[1]"}++, @capture };	266	@capture = do { my %seen; grep !$seen{"$_->[0],$_->[1]"}++, @capture };
206		267
207	# remove captured stones	268	# remove captured stones
208	$self->{captures}[$self->{last}] += @capture;	269	$self->{captures}[$own == MARK_B ? COLOUR_BLACK : COLOUR_WHITE] += @capture;
209	$self->{board}[$_->[0]][$_->[1]] &= ~(MARK_B \| MARK_W \| MARK_MOVE)	270	$self->{board}[$_->[0]][$_->[1]] = 0
210	for @capture;	271	for @capture;
211		272
212	$suicide += $self->capture ($own, $x, $y);	273	$suicide += $self->capture ($own, $x, $y);
213		274
214	${ $_->[5] } \|\|= !(@capture \|\| $suicide);	275	${ $_->[5] } \|\|= !(@capture \|\| $suicide);
…		…
222	$libs++ if $x < $self->{max} && !($board->[$x+1][$y] & $opp);	283	$libs++ if $x < $self->{max} && !($board->[$x+1][$y] & $opp);
223	$libs++ if $y > 0 && !($board->[$x][$y-1] & $opp);	284	$libs++ if $y > 0 && !($board->[$x][$y-1] & $opp);
224	$libs++ if $y < $self->{max} && !($board->[$x][$y+1] & $opp);	285	$libs++ if $y < $self->{max} && !($board->[$x][$y+1] & $opp);
225		286
226	if ($libs == 1) {	287	if ($libs == 1) {
227	$board->[$x][$y] = $board->[$x][$y] & ~MARK_CIRCLE \| (MARK_KO & $nodemask);	288	$$space = $$space & ~$mark_symbols \| MARK_KO;
		289
228	($x, $y) = @{$capture[0]};	290	($x, $y) = @{$capture[0]};
229	$board->[$x][$y] \|= MARK_KO & $nodemask;	291	$board->[$x][$y] \|= MARK_KO;
		292
		293	push @{ $self->{unmark} }, \$board->[$x][$y];
230	}	294	}
231	}	295	}
232	}	296	}
233	}	297	}
234	} else {
235	$self->{last} = $set & MARK_B ? COLOUR_BLACK : COLOUR_WHITE;
236	}	298	}
237	}	299	}
238	}	300	}
239		301
240	=item $board->is_valid_move ($colour, $x, $y[, $may_suicide])	302	=item $board->is_valid_move ($colour, $x, $y[, $may_suicide])
241		303
242	Returns true if the move of the given colour on the given coordinates is	304	Returns true if the move of the given colour on the given coordinates is
243	valid or not.	305	valid or not. Kos are taken into account as long as they are marked with
		306	C<MARK_KO>. Suicides are invalid unless C<$may_suicide> is true (e.g. for
		307	new zealand rules)
244		308
245	=cut	309	=cut
246		310
247	sub is_valid_move {	311	sub is_valid_move {
248	my ($self, $colour, $x, $y, $may_suicide) = @_;	312	my ($self, $colour, $x, $y, $may_suicide) = @_;
…		…
278		342
279	Marc Lehmann <schmorp@schmorp.de>	343	Marc Lehmann <schmorp@schmorp.de>
280		344
281	=head2 SEE ALSO	345	=head2 SEE ALSO
282		346
283	L<KGS::Protocol>, L<KGS::Game::Tree>, L<Gtk2::GoBoard>.	347	L<Gtk2::GoBoard>.
284		348
285	=cut	349	=cut
286		350

Diff Legend

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

Comparing Games-Go-SimpleBoard/SimpleBoard.pm (file contents): Revision 1.2 by root, Mon Jun 23 00:38:35 2008 UTC vs. Revision 1.10 by root, Wed Jun 25 20:49:38 2008 UTC

Diff Legend

Comparing Games-Go-SimpleBoard/SimpleBoard.pm (file contents):
Revision 1.2 by root, Mon Jun 23 00:38:35 2008 UTC vs.
Revision 1.10 by root, Wed Jun 25 20:49:38 2008 UTC