| 1 |
pcg |
1.1 |
package KGS::Game::Tree; |
| 2 |
|
|
|
| 3 |
|
|
use KGS::Constants; |
| 4 |
|
|
|
| 5 |
|
|
# _should_ be unified, but the two types are slightly different |
| 6 |
|
|
# (this really looks like a grown, as opposed to designed, protocol) |
| 7 |
|
|
my %marker_type = ( |
| 8 |
|
|
triangle => MARK_TRIANGLE, |
| 9 |
|
|
square => MARK_SQUARE, |
| 10 |
|
|
circle => MARK_CIRCLE, |
| 11 |
|
|
small_b => MARK_SMALL_B, |
| 12 |
|
|
small_w => MARK_SMALL_W, |
| 13 |
|
|
); |
| 14 |
|
|
|
| 15 |
|
|
# exclusion masks... the bit on the left excludes (removes) the ones on the right |
| 16 |
|
|
my %exclude_type = ( |
| 17 |
|
|
&MARK_TRIANGLE => MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL, |
| 18 |
|
|
&MARK_SQUARE => MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL, |
| 19 |
|
|
&MARK_CIRCLE => MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL, |
| 20 |
|
|
&MARK_LABEL => MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL, |
| 21 |
|
|
&MARK_SMALL_B => MARK_SMALL_B | MARK_SMALL_W | MARK_B | MARK_W | MARK_MOVE, |
| 22 |
|
|
&MARK_SMALL_W => MARK_SMALL_B | MARK_SMALL_W | MARK_B | MARK_W | MARK_MOVE, |
| 23 |
pcg |
1.3 |
&MARK_GRAY_B => MARK_B | MARK_W | MARK_MOVE | MARK_GRAY_B | MARK_GRAY_W, |
| 24 |
|
|
&MARK_GRAY_W => MARK_B | MARK_W | MARK_MOVE | MARK_GRAY_B | MARK_GRAY_W, |
| 25 |
|
|
&MARK_B => MARK_SMALL_B | MARK_SMALL_W | MARK_B | MARK_W | MARK_MOVE | MARK_GRAY_B | MARK_GRAY_W, |
| 26 |
|
|
&MARK_W => MARK_SMALL_B | MARK_SMALL_W | MARK_B | MARK_W | MARK_MOVE | MARK_GRAY_B | MARK_GRAY_W, |
| 27 |
pcg |
1.1 |
); |
| 28 |
|
|
|
| 29 |
|
|
sub init_tree { |
| 30 |
|
|
my ($self) = @_; |
| 31 |
|
|
$self->{tree} = [ { id => 0 } ]; |
| 32 |
|
|
} |
| 33 |
|
|
|
| 34 |
|
|
sub update_tree { |
| 35 |
|
|
my ($self, $tree) = @_; |
| 36 |
|
|
|
| 37 |
|
|
my $node = $self->{curnode}; |
| 38 |
|
|
|
| 39 |
|
|
for (@$tree) { |
| 40 |
|
|
my ($type, @arg) = @$_; |
| 41 |
|
|
if ($type eq "add_child") { |
| 42 |
|
|
$node = $self->{tree}[$arg[0] + 1] |
| 43 |
pcg |
1.3 |
or die "FATAL: referencing nonexistent node $arg[0]+1!"; |
| 44 |
pcg |
1.1 |
|
| 45 |
|
|
my $new = { parent => $node->{id}, id => scalar @{$self->{tree}} }; |
| 46 |
|
|
|
| 47 |
|
|
push @{$self->{tree}}, $new; |
| 48 |
|
|
push @{$node->{children}}, $new->{id}; |
| 49 |
|
|
|
| 50 |
|
|
$node = $new; |
| 51 |
|
|
|
| 52 |
|
|
} elsif (my $bit = $marker_type{$type}) { |
| 53 |
pcg |
1.4 |
my $ref = $node->{"$arg[1],$arg[2]"} ||= []; |
| 54 |
pcg |
1.1 |
|
| 55 |
pcg |
1.4 |
$ref->[0] &= ~$exclude_type{$bit}; |
| 56 |
|
|
$ref->[0] |= $bit if $arg[0] != 2; |
| 57 |
|
|
$ref->[1] |= $exclude_type{$bit}; |
| 58 |
pcg |
1.1 |
|
| 59 |
|
|
} elsif ($type eq "label") { |
| 60 |
pcg |
1.4 |
my $ref = $node->{"$arg[1],$arg[2]"} ||= []; |
| 61 |
pcg |
1.1 |
|
| 62 |
pcg |
1.4 |
$ref->[0] &= ~$exclude_type{&MARK_LABEL}; |
| 63 |
|
|
undef $ref->[2]; |
| 64 |
pcg |
1.1 |
|
| 65 |
|
|
if (length $arg[0]) { |
| 66 |
pcg |
1.4 |
$ref->[0] |= MARK_LABEL; |
| 67 |
|
|
$ref->[1] |= $exclude_type{&MARK_LABEL}; |
| 68 |
|
|
$ref->[2] = $arg[0]; |
| 69 |
pcg |
1.1 |
} |
| 70 |
|
|
|
| 71 |
pcg |
1.3 |
} elsif ($type eq "move" or $type eq "addstone" or $type eq "gray") { |
| 72 |
pcg |
1.4 |
my $ref = $node->{"$arg[1],$arg[2]"} ||= []; |
| 73 |
|
|
|
| 74 |
pcg |
1.3 |
my $bit = $arg[0] == 0 ? $bit | ($type eq "gray" ? MARK_GRAY_B : MARK_B) |
| 75 |
|
|
: $arg[0] == 1 ? $bit | ($type eq "gray" ? MARK_GRAY_W : MARK_W) |
| 76 |
|
|
: 0; |
| 77 |
|
|
|
| 78 |
pcg |
1.4 |
$ref->[0] &= ~$exclude_type{$bit}; |
| 79 |
|
|
$ref->[0] |= $bit | ($type eq "move" ? MARK_MOVE : 0); |
| 80 |
|
|
$ref->[1] |= $exclude_type{$bit}; |
| 81 |
pcg |
1.1 |
|
| 82 |
|
|
} elsif ($type eq "comment") { |
| 83 |
pcg |
1.3 |
$node->{comment} .= $arg[0]; |
| 84 |
|
|
|
| 85 |
|
|
} elsif ($type eq "player") { |
| 86 |
|
|
$node->{player}[$arg[0]] = $arg[1]; |
| 87 |
pcg |
1.1 |
|
| 88 |
pcg |
1.2 |
} elsif ($type eq "time_left") { |
| 89 |
pcg |
1.3 |
$node->{time}[$arg[0]] = [$arg[1], $arg[2]]; |
| 90 |
|
|
|
| 91 |
|
|
} elsif ($type eq "more") { |
| 92 |
|
|
$self->{more} = 1; |
| 93 |
|
|
$self->msg(get_tree => channel => $self->{channel}, node => @{$self->{tree}} - 1); |
| 94 |
|
|
|
| 95 |
|
|
} elsif ($type eq "done") { |
| 96 |
|
|
$self->{loaded} = 1; |
| 97 |
|
|
# nop |
| 98 |
pcg |
1.2 |
|
| 99 |
pcg |
1.1 |
} else { |
| 100 |
|
|
warn "unknown node parameter $type (@arg), ignored\n"; |
| 101 |
|
|
} |
| 102 |
|
|
} |
| 103 |
|
|
|
| 104 |
|
|
$self->{curnode} = $node; |
| 105 |
|
|
} |
| 106 |
|
|
|
| 107 |
|
|
sub get_path { |
| 108 |
|
|
my ($self) = @_; |
| 109 |
|
|
|
| 110 |
|
|
my @nodes; |
| 111 |
|
|
|
| 112 |
|
|
my $node = $self->{curnode}; |
| 113 |
|
|
|
| 114 |
|
|
for(;;) { |
| 115 |
|
|
push @nodes, $node; |
| 116 |
|
|
last unless $node->{parent}; |
| 117 |
|
|
$node = $self->{tree}[$node->{parent}]; |
| 118 |
|
|
} |
| 119 |
|
|
|
| 120 |
|
|
[reverse @nodes]; |
| 121 |
|
|
} |
| 122 |
|
|
|
| 123 |
|
|
sub set_node { |
| 124 |
|
|
my ($self, $node) = @_; |
| 125 |
|
|
|
| 126 |
|
|
$self->{curnode} = $self->{tree}[$node + 1] |
| 127 |
|
|
or die "set_node to undefined tree node $node+1"; |
| 128 |
|
|
} |
| 129 |
|
|
|
| 130 |
|
|
1; |
| 131 |
|
|
|
