| 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 |
|
|
grayed => MARK_GRAYED, |
| 14 |
|
|
); |
| 15 |
|
|
|
| 16 |
|
|
# exclusion masks... the bit on the left excludes (removes) the ones on the right |
| 17 |
|
|
my %exclude_type = ( |
| 18 |
|
|
&MARK_TRIANGLE => MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL, |
| 19 |
|
|
&MARK_SQUARE => MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL, |
| 20 |
|
|
&MARK_CIRCLE => MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL, |
| 21 |
|
|
&MARK_LABEL => MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL, |
| 22 |
|
|
&MARK_SMALL_B => MARK_SMALL_B | MARK_SMALL_W | MARK_B | MARK_W | MARK_MOVE, |
| 23 |
|
|
&MARK_SMALL_W => MARK_SMALL_B | MARK_SMALL_W | MARK_B | MARK_W | MARK_MOVE, |
| 24 |
|
|
&MARK_B => MARK_SMALL_B | MARK_SMALL_W | MARK_B | MARK_W | MARK_MOVE, |
| 25 |
|
|
&MARK_W => MARK_SMALL_B | MARK_SMALL_W | MARK_B | MARK_W | MARK_MOVE, |
| 26 |
|
|
&MARK_MOVE => MARK_SMALL_B | MARK_SMALL_W | MARK_B | MARK_W | MARK_MOVE, |
| 27 |
|
|
); |
| 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 |
|
|
or die "FATAL: referencing nonexistent node!"; |
| 44 |
|
|
|
| 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 |
|
|
my $ref = \$node->{"$arg[1],$arg[2]"}; |
| 54 |
|
|
|
| 55 |
|
|
$$ref &= ~$exclude_type{$bit}; |
| 56 |
|
|
$$ref |= $bit if $arg[0] != 2; |
| 57 |
|
|
|
| 58 |
|
|
} elsif ($type eq "label") { |
| 59 |
|
|
my $ref = \$node->{"$arg[1],$arg[2]"}; |
| 60 |
|
|
|
| 61 |
|
|
$$ref &= $exclude_type{&MARK_LABEL}; |
| 62 |
|
|
delete $node->{"L$arg[1],$arg[2]"}; |
| 63 |
|
|
|
| 64 |
|
|
if (length $arg[0]) { |
| 65 |
|
|
$$ref |= MARK_LABEL; |
| 66 |
|
|
$node->{"L$arg[1],$arg[2]"} = $arg[0]; |
| 67 |
|
|
} |
| 68 |
|
|
|
| 69 |
|
|
} elsif ($type eq "move" or $type eq "addstone") { |
| 70 |
|
|
my $bit = $type eq "move" ? MARK_MOVE : 0; |
| 71 |
|
|
|
| 72 |
|
|
$bit = $arg[0] == 0 ? $bit | MARK_B |
| 73 |
|
|
: $arg[0] == 1 ? $bit | MARK_W |
| 74 |
|
|
: 0; |
| 75 |
|
|
|
| 76 |
|
|
my $ref = \$node->{"$arg[1],$arg[2]"}; |
| 77 |
|
|
|
| 78 |
|
|
$$ref &= $exclude_type{&MARK_MOVE}; |
| 79 |
|
|
$$ref |= $bit; |
| 80 |
|
|
|
| 81 |
|
|
} elsif ($type eq "comment") { |
| 82 |
|
|
$self->{comment} .= $arg[0]; |
| 83 |
|
|
|
| 84 |
pcg |
1.2 |
} elsif ($type eq "time_left") { |
| 85 |
|
|
$self->{time}[$arg[0]] = [$arg[1], $arg[2]]; |
| 86 |
|
|
|
| 87 |
pcg |
1.1 |
} else { |
| 88 |
|
|
warn "unknown node parameter $type (@arg), ignored\n"; |
| 89 |
|
|
} |
| 90 |
|
|
} |
| 91 |
|
|
|
| 92 |
|
|
$self->{curnode} = $node; |
| 93 |
|
|
} |
| 94 |
|
|
|
| 95 |
|
|
sub get_path { |
| 96 |
|
|
my ($self) = @_; |
| 97 |
|
|
|
| 98 |
|
|
my @nodes; |
| 99 |
|
|
|
| 100 |
|
|
my $node = $self->{curnode}; |
| 101 |
|
|
|
| 102 |
|
|
for(;;) { |
| 103 |
|
|
push @nodes, $node; |
| 104 |
|
|
last unless $node->{parent}; |
| 105 |
|
|
$node = $self->{tree}[$node->{parent}]; |
| 106 |
|
|
} |
| 107 |
|
|
|
| 108 |
|
|
[reverse @nodes]; |
| 109 |
|
|
} |
| 110 |
|
|
|
| 111 |
|
|
sub set_node { |
| 112 |
|
|
my ($self, $node) = @_; |
| 113 |
|
|
|
| 114 |
|
|
$self->{curnode} = $self->{tree}[$node + 1] |
| 115 |
|
|
or die "set_node to undefined tree node $node+1"; |
| 116 |
|
|
} |
| 117 |
|
|
|
| 118 |
|
|
1; |
| 119 |
|
|
|
