| 1 |
package KGS::Game::Tree; |
| 2 |
|
| 3 |
use Games::Go::SimpleBoard; |
| 4 |
|
| 5 |
use KGS::Constants; |
| 6 |
|
| 7 |
# exclusion masks... the bit on the left excludes (removes) the ones on the right |
| 8 |
my %exclude_type = ( |
| 9 |
&MARK_TRIANGLE => MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL, |
| 10 |
&MARK_SQUARE => MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL, |
| 11 |
&MARK_CIRCLE => MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL, |
| 12 |
&MARK_LABEL => MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL, |
| 13 |
&MARK_SMALL_B => MARK_SMALL_B | MARK_SMALL_W | MARK_MOVE, |
| 14 |
&MARK_SMALL_W => MARK_SMALL_B | MARK_SMALL_W | MARK_MOVE, |
| 15 |
&MARK_GRAYED => MARK_MOVE | MARK_GRAYED, |
| 16 |
&MARK_B => MARK_B | MARK_W | MARK_MOVE | MARK_GRAYED, #d# was !MARK_GRAYED here |
| 17 |
&MARK_W => MARK_B | MARK_W | MARK_MOVE | MARK_GRAYED, #d# was !MARK_GRAYED here |
| 18 |
); |
| 19 |
|
| 20 |
sub init_tree { |
| 21 |
my ($self) = @_; |
| 22 |
$self->{tree} = [ { |
| 23 |
id => 0, |
| 24 |
move => -1, |
| 25 |
} ]; |
| 26 |
} |
| 27 |
|
| 28 |
sub update_tree { |
| 29 |
my ($self, $tree) = @_; |
| 30 |
|
| 31 |
my $node = $self->{curnode}; |
| 32 |
|
| 33 |
my $up_tree; |
| 34 |
my $up_move; |
| 35 |
|
| 36 |
#Carp::cluck KGS::Listener::Debug::dumpval $tree;#d# |
| 37 |
|
| 38 |
#warn "update_tree = ".KGS::Listener::Debug::dumpval $tree;#d# |
| 39 |
|
| 40 |
for (@$tree) { |
| 41 |
my ($type, @arg) = @$_; |
| 42 |
if ($type eq "add_node") { |
| 43 |
$up_tree = 1; |
| 44 |
$node = $self->{tree}[$arg[0] + 1] |
| 45 |
or die "FATAL: referencing nonexistent node $arg[0]+1!"; |
| 46 |
|
| 47 |
my $new = { |
| 48 |
id => scalar @{$self->{tree}}, |
| 49 |
parent => $node->{id}, |
| 50 |
move => $node->{move} + 1, |
| 51 |
}; |
| 52 |
|
| 53 |
push @{$self->{tree}}, $new; |
| 54 |
push @{$node->{children}}, $new->{id}; |
| 55 |
|
| 56 |
$node = $new; |
| 57 |
|
| 58 |
} elsif ($type eq "set_node") { |
| 59 |
$node = $self->{tree}[$arg[0] + 1] |
| 60 |
or die "set_node to undefined tree node $arg[0]+1"; |
| 61 |
|
| 62 |
} elsif ($type eq "set_current") { |
| 63 |
$up_tree = 1; |
| 64 |
$node = $self->{tree}[$arg[0] + 1] |
| 65 |
or die "set_current to undefined tree node $arg[0]+1"; |
| 66 |
|
| 67 |
$self->{curnode} = $node; |
| 68 |
|
| 69 |
} elsif ($type eq "mark") { |
| 70 |
$up_tree = 1; |
| 71 |
|
| 72 |
my $bit = $arg[1]; |
| 73 |
my $ref = $node->{"$arg[2],$arg[3]"} ||= []; |
| 74 |
|
| 75 |
$ref->[0] &= ~$exclude_type{$bit}; |
| 76 |
$ref->[0] |= $bit if $arg[0]; |
| 77 |
$ref->[1] |= $exclude_type{$bit}; |
| 78 |
|
| 79 |
$ref->[2] = $arg[4] if $bit == MARK_LABEL; |
| 80 |
|
| 81 |
} elsif ($type eq "set_stone" or $type eq "move") { |
| 82 |
$up_tree = 1; |
| 83 |
|
| 84 |
if ($type eq "move") { |
| 85 |
$self->{lastmove_time} = $KGS::Protocol::NOW; |
| 86 |
$self->{lastmove_colour} = $arg[0]; |
| 87 |
$up_move = $arg[1] == 255 if $self->{loaded}; |
| 88 |
} |
| 89 |
|
| 90 |
if ($arg[1] < 255) { |
| 91 |
my $ref = $node->{"$arg[1],$arg[2]"} ||= []; |
| 92 |
|
| 93 |
my $bit = $arg[0] == COLOUR_BLACK ? MARK_B |
| 94 |
: $arg[0] == COLOUR_WHITE ? MARK_W |
| 95 |
: 0; |
| 96 |
|
| 97 |
$ref->[0] &= ~$exclude_type{$bit || MARK_B}; |
| 98 |
$ref->[0] |= $bit | ($type eq "move" ? MARK_MOVE : 0); |
| 99 |
$ref->[1] |= $exclude_type{$bit || MARK_B}; |
| 100 |
} else { |
| 101 |
warn "PLEASE REPORT: pass coordinates but type is $type" if $type ne "move";#d# |
| 102 |
|
| 103 |
$node->{pass} = 1; |
| 104 |
} |
| 105 |
|
| 106 |
} elsif ($type eq "comment") { |
| 107 |
if (!defined $arg[0]) { |
| 108 |
delete $node->{comment}; |
| 109 |
} else { |
| 110 |
$self->event_update_comments ($node, $arg[0], !exists $node->{comment}); |
| 111 |
$node->{comment} .= $arg[0]; |
| 112 |
} |
| 113 |
|
| 114 |
} elsif ($type eq "set_timer") { |
| 115 |
$up_tree = 1;#d# |
| 116 |
$node->{timer}[$arg[0]] = [$arg[1], $arg[2]]; |
| 117 |
|
| 118 |
} elsif ($type eq "score") { |
| 119 |
$up_tree = 1; |
| 120 |
$node->{score}[$arg[0]] = $arg[1]; |
| 121 |
|
| 122 |
} elsif ($type eq "player") { |
| 123 |
$node->{player}[$arg[0]] = $arg[1]; |
| 124 |
|
| 125 |
} elsif ($type eq "rank") { |
| 126 |
$node->{rank}[$arg[0]] = $arg[1]; |
| 127 |
|
| 128 |
} elsif ($type eq "more") { |
| 129 |
die; |
| 130 |
|
| 131 |
} elsif ($type eq "done") { |
| 132 |
die; |
| 133 |
$self->{loaded} = 1; |
| 134 |
# nop |
| 135 |
|
| 136 |
} else { |
| 137 |
$node->{$type} = $arg[0]; # rules, date etc.. |
| 138 |
|
| 139 |
$self->event_update_rules ($arg[0]) if $type eq "rules"; |
| 140 |
} |
| 141 |
} |
| 142 |
|
| 143 |
$self->{curnode} = $node; |
| 144 |
|
| 145 |
$self->event_move ($up_move) if defined $up_move; |
| 146 |
|
| 147 |
return $up_tree; |
| 148 |
} |
| 149 |
|
| 150 |
sub get_path { |
| 151 |
my ($self) = @_; |
| 152 |
|
| 153 |
my @nodes; |
| 154 |
|
| 155 |
my $node = $self->{curnode}; |
| 156 |
|
| 157 |
for(;;) { |
| 158 |
push @nodes, $node; |
| 159 |
last unless $node->{parent}; |
| 160 |
$node = $self->{tree}[$node->{parent}]; |
| 161 |
} |
| 162 |
|
| 163 |
[reverse @nodes]; |
| 164 |
} |
| 165 |
|
| 166 |
sub gen_move_tree { |
| 167 |
my ($self, $colour, $x, $y) = @_; |
| 168 |
|
| 169 |
[#d# |
| 170 |
#NYI# |
| 171 |
[add_node => 0], |
| 172 |
]; |
| 173 |
} |
| 174 |
|
| 175 |
sub event_move { } |
| 176 |
sub event_update_tree { } |
| 177 |
sub event_update_comments { } |
| 178 |
sub event_update_rules { } |
| 179 |
|
| 180 |
1; |
| 181 |
|
