KGS/Game/Tree.pm

package KGS::Game::Tree;

use Gtk2::GoBoard::Constants;

use KGS::Constants;

# exclusion masks... the bit on the left excludes (removes) the ones on the right
my %exclude_type = (
   &MARK_TRIANGLE => MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL,
   &MARK_SQUARE   => MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL,
   &MARK_CIRCLE   => MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL,
   &MARK_LABEL    => MARK_SQUARE | MARK_TRIANGLE | MARK_CIRCLE | MARK_LABEL,
   &MARK_SMALL_B  => MARK_SMALL_B | MARK_SMALL_W |                   MARK_MOVE,
   &MARK_SMALL_W  => MARK_SMALL_B | MARK_SMALL_W |                   MARK_MOVE,
   &MARK_GRAYED   =>                                                 MARK_MOVE | MARK_GRAYED,
   &MARK_B        =>                               MARK_B | MARK_W | MARK_MOVE | MARK_GRAYED, #d# was !MARK_GRAYED here
   &MARK_W        =>                               MARK_B | MARK_W | MARK_MOVE | MARK_GRAYED, #d# was !MARK_GRAYED here
);

sub init_tree {
   my ($self) = @_;
   $self->{tree} = [ {
      id   => 0,
      move => -1,
   } ];
}

sub update_tree {
   my ($self, $tree) = @_;

   my $node = $self->{curnode};

   my $up_tree;
   my $up_move;

   #Carp::cluck KGS::Listener::Debug::dumpval $tree;#d#

   #warn "update_tree = ".KGS::Listener::Debug::dumpval $tree;#d#

   for (@$tree)  {
      my ($type, @arg) = @$_;
      if ($type eq "add_node") {
         $up_tree = 1;
         $node = $self->{tree}[$arg[0] + 1]
            or die "FATAL: referencing nonexistent node $arg[0]+1!";

         my $new = {
            id     => scalar @{$self->{tree}},
            parent => $node->{id},
            move   => $node->{move} + 1,
         };

         if ($arg[0] >= 0) {
         }

         push @{$self->{tree}}, $new;
         push @{$node->{children}}, $new->{id};

         $node = $new;

      } elsif ($type eq "set_node") {
         $node = $self->{tree}[$arg[0] + 1]
            or die "set_node to undefined tree node $arg[0]+1";

      } elsif ($type eq "set_current") {
         $up_tree = 1;
         $node = $self->{tree}[$arg[0] + 1]
            or die "set_current to undefined tree node $arg[0]+1";

         $self->{curnode} = $node;

      } elsif ($type eq "mark") {
         $up_tree = 1;

         my $bit = $arg[1];
         my $ref = $node->{"$arg[2],$arg[3]"} ||= [];

         $ref->[0] &= ~$exclude_type{$bit};
         $ref->[0] |= $bit if $arg[0];
         $ref->[1] |= $exclude_type{$bit};

         $ref->[2] = $arg[4] if $bit == MARK_LABEL;

      } elsif ($type eq "set_stone" or $type eq "move") {
         $up_tree = 1;

         if ($type eq "move") {
            $self->{lastmove_time}   = $KGS::Protocol::NOW;
            $self->{lastmove_colour} = $arg[0];
            $up_move = $arg[1] == 255 if $self->{loaded};
         }

         if ($arg[1] < 255) {
            my $ref = $node->{"$arg[1],$arg[2]"} ||= [];

            my $bit = $arg[0] == COLOUR_BLACK ? MARK_B
                    : $arg[0] == COLOUR_WHITE ? MARK_W
                    : 0;

            $ref->[0] &= ~$exclude_type{$bit || MARK_B};
            $ref->[0] |= $bit | ($type eq "move" ? MARK_MOVE : 0);
            $ref->[1] |= $exclude_type{$bit || MARK_B};
         } else {
            warn "PLEASE REPORT: pass coordinates but type is $type" if $type ne "move";#d#

            $node->{pass} = 1;
         }

      } elsif ($type eq "comment") {
         $self->event_update_comments ($node, $arg[0], !exists $node->{comment});

         $node->{comment} .= $arg[0];

      } elsif ($type eq "player") {
         $node->{player}[$arg[0]] = $arg[1];

      } elsif ($type eq "rank") {
         $node->{rank}[$arg[0]] = $arg[1];

      } elsif ($type eq "set_timer") {
         $node->{timer}[$arg[0]] = [$arg[1], $arg[2]];

      } elsif ($type eq "more") {
         die;

      } elsif ($type eq "done") {
         die;
         $self->{loaded} = 1;
         # nop

      } else {
         $node->{$type} = $arg[0]; # rules, date etc..

         $self->event_update_rules ($arg[0]) if $type eq "rules";
      }
   }

   $self->{curnode} = $node;

   $self->event_move ($up_move) if defined $up_move;

   return $up_tree;
}

sub get_path {
   my ($self) = @_;

   my @nodes;

   my $node = $self->{curnode};

   for(;;) {
      push @nodes, $node;
      last unless $node->{parent};
      $node = $self->{tree}[$node->{parent}];
   }

   [reverse @nodes];
}

sub gen_move_tree {
   my ($self, $colour, $x, $y) = @_;

   [#d#
      #NYI#
      [add_node => 0],
   ];
}

sub event_move            { }
sub event_update_tree     { }
sub event_update_comments { }
sub event_update_rules    { }

1;

Revision:	1.29
Committed:	Sun May 30 03:03:38 2004 UTC (22 years, 4 months ago) by pcg
Branch:	MAIN
Changes since 1.28:	+1 -0 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	pcg	1.1	package KGS::Game::Tree;
2
3	pcg	1.25	use Gtk2::GoBoard::Constants;
4	pcg	1.22
5	pcg	1.1	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	pcg	1.20	&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	pcg	1.26	&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	pcg	1.1	);
19
20			sub init_tree {
21			my ($self) = @_;
22	pcg	1.11	$self->{tree} = [ {
23			id => 0,
24	pcg	1.17	move => -1,
25	pcg	1.11	} ];
26	pcg	1.1	}
27
28			sub update_tree {
29	pcg	1.10	my ($self, $tree) = @_;
30	pcg	1.1
31			my $node = $self->{curnode};
32
33	pcg	1.12	my $up_tree;
34			my $up_move;
35
36	pcg	1.23	#Carp::cluck KGS::Listener::Debug::dumpval $tree;#d#
37	pcg	1.20
38	pcg	1.18	#warn "update_tree = ".KGS::Listener::Debug::dumpval $tree;#d#
39
40	pcg	1.1	for (@$tree) {
41			my ($type, @arg) = @$_;
42	pcg	1.20	if ($type eq "add_node") {
43	pcg	1.12	$up_tree = 1;
44	pcg	1.1	$node = $self->{tree}[$arg[0] + 1]
45	pcg	1.3	or die "FATAL: referencing nonexistent node $arg[0]+1!";
46	pcg	1.1
47	pcg	1.11	my $new = {
48			id => scalar @{$self->{tree}},
49			parent => $node->{id},
50			move => $node->{move} + 1,
51			};
52	pcg	1.1
53	pcg	1.28	if ($arg[0] >= 0) {
54			}
55
56	pcg	1.1	push @{$self->{tree}}, $new;
57			push @{$node->{children}}, $new->{id};
58
59			$node = $new;
60
61	pcg	1.20	} elsif ($type eq "set_node") {
62			$node = $self->{tree}[$arg[0] + 1]
63			or die "set_node to undefined tree node $arg[0]+1";
64
65			} elsif ($type eq "set_current") {
66			$up_tree = 1;
67			$node = $self->{tree}[$arg[0] + 1]
68			or die "set_current to undefined tree node $arg[0]+1";
69
70			$self->{curnode} = $node;
71
72			} elsif ($type eq "mark") {
73	pcg	1.12	$up_tree = 1;
74	pcg	1.20
75			my $bit = $arg[1];
76			my $ref = $node->{"$arg[2],$arg[3]"} \|\|= [];
77	pcg	1.1
78	pcg	1.4	$ref->[0] &= ~$exclude_type{$bit};
79	pcg	1.20	$ref->[0] \|= $bit if $arg[0];
80	pcg	1.4	$ref->[1] \|= $exclude_type{$bit};
81	pcg	1.1
82	pcg	1.21	$ref->[2] = $arg[4] if $bit == MARK_LABEL;
83	pcg	1.1
84	pcg	1.20	} elsif ($type eq "set_stone" or $type eq "move") {
85	pcg	1.12	$up_tree = 1;
86
87	pcg	1.13	if ($type eq "move") {
88			$self->{lastmove_time} = $KGS::Protocol::NOW;
89	pcg	1.27	$self->{lastmove_colour} = $arg[0];
90	pcg	1.26	$up_move = $arg[1] == 255 if $self->{loaded};
91	pcg	1.13	}
92
93	pcg	1.26	if ($arg[1] < 255) {
94			my $ref = $node->{"$arg[1],$arg[2]"} \|\|= [];
95	pcg	1.4
96	pcg	1.26	my $bit = $arg[0] == COLOUR_BLACK ? MARK_B
97			: $arg[0] == COLOUR_WHITE ? MARK_W
98			: 0;
99	pcg	1.3
100	pcg	1.26	$ref->[0] &= ~$exclude_type{$bit \|\| MARK_B};
101	pcg	1.7	$ref->[0] \|= $bit \| ($type eq "move" ? MARK_MOVE : 0);
102	pcg	1.26	$ref->[1] \|= $exclude_type{$bit \|\| MARK_B};
103	pcg	1.7	} else {
104	pcg	1.10	warn "PLEASE REPORT: pass coordinates but type is $type" if $type ne "move";#d#
105	pcg	1.7
106			$node->{pass} = 1;
107			}
108	pcg	1.6
109	pcg	1.1	} elsif ($type eq "comment") {
110	pcg	1.11	$self->event_update_comments ($node, $arg[0], !exists $node->{comment});
111
112	pcg	1.3	$node->{comment} .= $arg[0];
113
114			} elsif ($type eq "player") {
115			$node->{player}[$arg[0]] = $arg[1];
116	pcg	1.1
117	pcg	1.9	} elsif ($type eq "rank") {
118			$node->{rank}[$arg[0]] = $arg[1];
119
120	pcg	1.8	} elsif ($type eq "set_timer") {
121	pcg	1.10	$node->{timer}[$arg[0]] = [$arg[1], $arg[2]];
122	pcg	1.3
123			} elsif ($type eq "more") {
124	pcg	1.20	die;
125	pcg	1.3
126			} elsif ($type eq "done") {
127	pcg	1.20	die;
128	pcg	1.3	$self->{loaded} = 1;
129			# nop
130	pcg	1.2
131	pcg	1.1	} else {
132	pcg	1.9	$node->{$type} = $arg[0]; # rules, date etc..
133	pcg	1.14
134			$self->event_update_rules ($arg[0]) if $type eq "rules";
135	pcg	1.1	}
136			}
137	pcg	1.12
138	pcg	1.17	$self->{curnode} = $node;
139
140	pcg	1.12	$self->event_move ($up_move) if defined $up_move;
141	pcg	1.20
142			return $up_tree;
143	pcg	1.1	}
144
145			sub get_path {
146			my ($self) = @_;
147
148			my @nodes;
149
150			my $node = $self->{curnode};
151
152			for(;;) {
153			push @nodes, $node;
154			last unless $node->{parent};
155			$node = $self->{tree}[$node->{parent}];
156			}
157
158			[reverse @nodes];
159			}
160
161	pcg	1.28	sub gen_move_tree {
162			my ($self, $colour, $x, $y) = @_;
163
164			[#d#
165	pcg	1.29	#NYI#
166	pcg	1.28	[add_node => 0],
167			];
168			}
169
170	pcg	1.11	sub event_move { }
171			sub event_update_tree { }
172			sub event_update_comments { }
173	pcg	1.14	sub event_update_rules { }
174	pcg	1.5
175	pcg	1.1	1;
176