[ViewVC] Annotation of: cvs/kgsueme/bin/kgsueme

#!/opt/bin/perl

use PApp::Util qw(dumpval); # debug only

use Gtk;
use Gtk::Gdk;

use KGS::Protocol;
use KGS::Listener::Debug;

use IO::Socket::INET;

use Errno;

init Gtk;

$HACK = 1; # do NEVER enable. ;)

our $config;

{
   use Storable ();
   use Scalar::Util ();

   my $staterc = "$ENV{HOME}/.kgsueme";

   my $state = -r $staterc ? Storable::retrieve($staterc) : {};
   my @widgets;

   $config = $state->{config} ||= {};

   # grr... more gtk+ brokenness
   my %get = (
      hpane_position  => sub { ($_[0]->children)[0]->allocation->[2] },
      vpane_position  => sub { ($_[0]->children)[0]->allocation->[3] },
      window_size     => sub { [ @{$_[0]->allocation}[2,3] ] },
      #window_pos     => sub { die PApp::Util::dumpval [ $_[0]->get_root_origin ] },
      clist_column_widths => sub {
         $_[0]{column_widths};
      },
   );

   my %set = (
      hpane_position => sub { $_[0]->set_position($_[1]) },
      vpane_position => sub { $_[0]->set_position($_[1]) },
      window_size    => sub { $_[0]->set_default_size(@{$_[1]}) },
      #window_pos     => sub { $_[0]->set_uposition(@{$_[1]}) if @{$_[1]} },
      clist_column_widths => sub {
         my ($w, $v) = @_;
         $v->[$_] && $w->set_column_width($_, $v->[$_]) for 0..$#$v;
         $w->{column_widths} = $v;
         $w->signal_connect(resize_column => sub { $v->[$_[1]] = $_[2]; });
      },
   );

   sub state {
      my ($widget, $class, $instance, %attr) = @_;

      while (my ($k, $v) = each %attr) {
         my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
         $v = $state->{$class}{"*"}{$get}       if exists $state->{$class}{"*"}{$get};
         $v = $state->{$class}{$instance}{$get} if exists $state->{$class}{$instance}{$get};
         $set{$get} ? $set{$get}->($widget, $v) : $widget->set($set => $v);
      }

      $widget = [$widget, $class, $instance, \%attr];
      Scalar::Util::weaken $widget->[0];

      @widgets = (grep $_->[0], @widgets, $widget);
   }

   sub save_state {
      for (@widgets) {
         if ($_->[0]) {
            my ($widget, $class, $instance, $attr) = @$_;
            while (my ($k, $v) = each %$attr) {
               my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
               $v = $get{$get} ? $get{$get}->($widget) : $widget->get($get);

               $state->{$class}{"*"}{$get}       = $v;
               $state->{$class}{$instance}{$get} = $v;
            }
         }
         ::status("save_state", "layout saved");
      }

      Storable::nstore($state, $staterc);
   }
}

# make a clist unselectable
sub clist_autosort {
   my $w = shift;
   my ($c, $o) = (-1);
   for (0..$w->columns-1) {
      $w->signal_connect(click_column => sub {
         if ($_[1] != $c) {
            $c = $_[1];
            $o = 0;
         } else {
            $o = !$o;
         }
         $w->set_sort_column($c);
         $w->set_sort_type($o ? "descending" : "ascending");
         $w->sort;
      });
   }
   
}

{
   my $main = new kgsueme;

   my %context_id;

   sub status {
      my ($type, $text) = @_;

      $main->{status}->pop($context_id{$type}) if $context_id{$type};
      $main->{status}->push($context_id{$type} ||= $main->{status}->get_context_id($type), $text) if $text;
   }
}

main Gtk;

#############################################################################

package kgsueme;

use base KGS::Listener;

sub new {
   my $self = shift;
   $self = $self->SUPER::new(@_);

   $self->{conn} = new KGS::Protocol;

   KGS::Listener::Debug->new->listen($self->{conn}); #d# debug only :)

   $self->listen($self->{conn});

   $self->{window} = new Gtk::Window 'toplevel';
   $self->{window}->set_title('kgsueme');
   ::state $self->{window}, "main::window", undef, window_size => [400, 100];
   $self->{window}->signal_connect(delete_event => sub { main_quit Gtk });

   $self->{window}->add(my $vbox = new Gtk::VBox);

   $vbox->pack_start(($self->{buttonbox} = new Gtk::HButtonBox), 0, 1, 0);

   my $button = sub {
      $self->{buttonbox}->add(my $button = new Gtk::Button $_[0]);
      signal_connect $button clicked => $_[1];
   };

   $button->("Login", sub {
      $self->login;
   });
   $button->("Roomlist", sub {
      $self->{roomlist} ||= new roomlist conn => $self->{conn};
      $self->{roomlist}->show;
   });
   $button->("Save Config & Layout", sub { ::save_state });

   $vbox->pack_start((my $hbox = new Gtk::HBox), 0, 1, 0);

   $hbox->add(new Gtk::Label "Login");

   $hbox->add($self->{login} = new_with_max_length Gtk::Entry 12);
   $self->{login}->set_text($::config->{login});

   if ($::HACK) {
      $self->{login}->signal_connect(activate => sub {
         $self->{conn}{name} = $self->{login}->get_text;
      });
   }

   $hbox->add(new Gtk::Label "Password");
   $hbox->add($self->{password} = new Gtk::Entry);
   $self->{password}->set_visibility(0);

   $vbox->pack_start(($self->{status} = new Gtk::Statusbar), 0, 1, 0);

   $self->{window}->show_all;

   $self;
}

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

   $self->{conn}->disconnect;

   # initialize new socket and connection
   my $sock = new IO::Socket::INET PeerHost => "kgs.kiseido.com", PeerPort => "2379"
      or die;

   $sock->blocking(1);
   $self->{conn}->handshake($sock);
   $sock->blocking(0);

   my $input; $input = input_add Gtk::Gdk fileno $sock, "read", sub {
      # this is dorked
      my $buf;
      if (0 >= sysread $sock, $buf, 16384
          and !$!{EINTR} and !$!{EAGAIN}) {
         input_remove Gtk::Gdk $input;
         $self->event_disconnect;
      }
      $self->{conn}->feed_data($buf);
   };

   # now login
   $self->{conn}->login($self->{login}->get_text, $self->{password}->get_text);
}

sub inject_login {
   my ($self, $msg) = @_;

   ::status("login", "logged in as '$self->{conn}{name}' with status '$msg->{result}'");
   $::config->{login} = $self->{conn}{name};

   $self->{window}->show_all;
}

sub event_disconnect { }

#############################################################################

package roomlist;

use base KGS::Listener::Roomlist;

sub new {
   my $self = shift;
   $self = $self->SUPER::new(@_);

   $self->listen($self->{conn});

   $self->{window} = new Gtk::Window 'toplevel';
   $self->{window}->set_title('KGS Rooms');
   ::state $self->{window}, "roomlist::window", undef, window_size => [400, 200];

   $self->{window}->signal_connect(delete_event => sub { hide $self->{window} });

   $self->{window}->add(my $vbox = new Gtk::VBox);

   $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
   $sw->set_policy("automatic", "always");

   $sw->add($self->{roomlist} = new_with_titles Gtk::CList "Group", "Room Name", "Users", "Games", "Flags", "Channel");
   $self->{roomlist}->set_selection_mode('multiple');
   ::clist_autosort $self->{roomlist};
   ::state $self->{roomlist}, "roomlist::roomlist", undef, clist_column_widths => [20, 200];

   $self->{roomlist}->signal_connect(select_row => sub {
      my $room = $self->{roomlist}->get_row_data($_[1])
         or return;
      $self->{room}{$room->{channel}} ||= new room %$room, conn => $self->{conn}, users => {};
      $self->{room}{$room->{channel}}->join;
      $self->{roomlist}->unselect_all;
   });

   $self;
}

sub show {
   my ($self, $msg) = @_;

   $self->msg(list_rooms => group => $_) for 0..5; # fetch all room names (should not!)
   $self->{window}->show_all;
}

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

   $self->{event_update} ||= Gtk->timeout_add(200, sub {
      my $l = $self->{roomlist};

      $l->freeze;
      my $pos = $l->get_vadjustment->get_value;
      $l->clear;

      my $row = 0;
      for (values %{$self->{rooms}}) {
         $l->append($_->{group}, $_->{name}, $_->{users}, $_->{games}, $_->{flags}, $_->{channel});
         $l->set_row_data($row++, $_);
      }
      $l->sort;
      $l->get_vadjustment->set_value($pos);
      $l->thaw;

      delete $self->{event_update};
      0;
   });
}

#############################################################################

package room;

use base KGS::Listener::Room;

sub new {
   my $self = shift;
   $self = $self->SUPER::new(@_);

   $self->listen($self->{conn});

   $self->{window} = new Gtk::Window 'toplevel';
   $self->{window}->set_title("KGS Room $self->{name}");
   ::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400];

   $self->{window}->signal_connect(delete_event => sub { $self->part });

   $self->{window}->add(my $hpane = new Gtk::HPaned);
   ::state $hpane, "room::hpane", $self->{name}, hpane_position => 200;

   $hpane->add(my $vpane = new Gtk::VPaned);
   ::state $vpane, "room::vpane", $self->{name}, vpane_position => 200;

   $vpane->add(my $sw = new Gtk::ScrolledWindow);
   $sw->set_policy("automatic", "always");

   $sw->add($self->{gamelist} = new_with_titles Gtk::CList "T", "Black", "White", "Rules", "Notes");
   ::clist_autosort $self->{gamelist};
   ::state $self->{gamelist}, "room::gamelist", $self->{name}, clist_column_widths => [20, 120, 120, 120];

   $self->{gamelist}->signal_connect(select_row => sub {
      my $game = $self->{gamelist}->get_row_data($_[1])
         or return;
      $self->{game}{$game->{channel}} ||= new game %$game, conn => $self->{conn};
      $self->{game}{$game->{channel}}->join;
      $self->{gamelist}->unselect_all;
   });

   $vpane->add(my $vbox = new Gtk::VBox);
   
   $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
   $sw->set_policy("automatic", "always");

   $sw->add($self->{text} = new Gtk::Text);

   $vbox->pack_start(($self->{entry} = new Gtk::Entry), 0, 1, 0);
   $self->{entry}->signal_connect(activate => sub {
      my $text = $self->{entry}->get_text;
      $self->say($text) if $text =~ /\S/;
      $self->{entry}->set_text("");
   });

   $hpane->add(my $sw = new Gtk::ScrolledWindow);
   $sw->set_policy("automatic", "always");

   $sw->add($self->{userlist} = new_with_titles Gtk::CList "User", "Rank", "Flags");
   ::clist_autosort $self->{userlist};
   ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];

   $self;
}

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

   $self->{event_update} ||= Gtk->timeout_add(200, sub {
      my $l = $self->{userlist};

      $l->freeze;
      my $pos = $l->get_vadjustment->get_value;
      $l->clear;

      my $row = 0;
      for (values %{$self->{users}}) {
         $l->append($_->{name});
         $l->set_row_data($row++, $_);
      }
      $l->sort;
      $l->get_vadjustment->set_value($pos);
      $l->thaw;

      delete $self->{event_update};
      0;
   });
}

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

   $self->{event_update_games} ||= Gtk->timeout_add(200, sub {
      my $l = $self->{gamelist};

      $l->freeze;
      my $pos = $l->get_vadjustment->get_value;
      $l->clear;

      my $row = 0;
      for (values %{$self->{games}}) {
         $l->append($_->type, $_->user0, $_->user1, $_->rules, $_->notes);
         $l->set_row_data($row++, $_);
      }
      $l->sort;
      $l->get_vadjustment->set_value($pos);
      $l->thaw;

      delete $self->{event_update_games};
      0;
   });
}

sub join {
   my ($self) = @_;
   $self->SUPER::join;

   $self->{window}->show_all;
}

sub part {
   my ($self) = @_;
   $self->SUPER::part;

   $self->{window}->hide_all;
   $self->event_update;
   $self->event_update_games;
}

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

   $self->{text}->insert(undef, undef, undef, "$self->{owner}: $self->{description}\n\n");
}

sub inject_msg_room {
   my ($self, $msg) = @_;
   return unless $self->{channel} == $msg->{channel};

   $self->{text}->insert(undef, undef, undef, "$msg->{name}: $msg->{message}\n");
}

#############################################################################

package game;

use base KGS::Listener::Game;
use base KGS::Game;

sub new {
   my $self = shift;
   $self = $self->SUPER::new(@_);

   $self->listen($self->{conn});

   $self->{window} = new Gtk::Window 'toplevel';
   $self->{window}->set_title("KGS Game ".$self->user0." ".$self->user1);
   ::state $self->{window}, "game::window", undef, window_size => [600, 500];

   $self->{window}->signal_connect(delete_event => sub { $self->part });

   $self->{window}->add(my $hpane = new Gtk::HPaned);
   ::state $hpane, "game::hpane", undef, hpane_position => 500;

   $hpane->add(my $board = new Gtk::Table $self->{size}, $self->{size}, 1);

   for my $x (0 .. $self->{size} - 1) {
      for my $y (0 .. $self->{size} - 1) {
         my $cell = new Gtk::Label;
         $board->attach_defaults($cell, $x, $x + 1, $y, $y + 1);
         $self->{board}[$x][$y] = $cell;
      }
   }

   $hpane->add(my $vpane = new Gtk::VPaned);
   ::state $vpane, "game", $self->{name}, vpane_position => 80;

   $vpane->add(my $sw = new Gtk::ScrolledWindow);
   $sw->set_policy("automatic", "always");

   $sw->add($self->{userlist} = new_with_titles Gtk::CList "User", "Rank", "Flags");
   ::clist_autosort $self->{userlist};
   ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];

   $vpane->add(my $vbox = new Gtk::VBox);
   
   $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
   $sw->set_policy("automatic", "always");

   $sw->add($self->{text} = new Gtk::Text);

   $vbox->pack_start(($self->{entry} = new Gtk::Entry), 0, 1, 0);
   $self->{entry}->signal_connect(activate => sub {
      my $text = $self->{entry}->get_text;
      # add message
      $self->{entry}->set_text("");
   });

   $self;
}

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

   $self->{event_update} ||= Gtk->timeout_add(200, sub {
      my $l = $self->{userlist};

      $l->freeze;
      my $pos = $l->get_vadjustment->get_value;
      $l->clear;

      my $row = 0;
      for (values %{$self->{users}}) {
         $l->append($_->{name});
         $l->set_row_data($row++, $_);
      }
      $l->sort;
      $l->get_vadjustment->set_value($pos);
      $l->thaw;

      delete $self->{event_update};
      0;
   });
}

sub join {
   my ($self) = @_;
   $self->SUPER::join;

   $self->{window}->show_all;
}

sub part {
   my ($self) = @_;
   $self->SUPER::part;

   $self->{window}->hide_all;
   $self->event_update;
}

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

   for my $x (0 .. $self->{size} - 1) {
      for my $y (0 .. $self->{size} - 1) {
         $self->{board}[$x][$y]->set_text("");
      }
   }

   for (0..$self->{node}) {
      while (my ($k, $v) = each %{$self->{tree}[$_]}) {
         if ($k eq "move7") {
            if ($v->[1] < 255) {
               $self->{board}[$v->[1]][$v->[2]]->set_text(("X", "O", "-")[$v->[0]]);
            }
         }
      }
   }
}

1;


Revision:	1.3
Committed:	Wed May 28 22:26:25 2003 UTC (21 years ago) by pcg
Branch:	MAIN
Changes since 1.2:	+8 -0 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	pcg	1.1	#!/opt/bin/perl
2
3			use PApp::Util qw(dumpval); # debug only
4
5			use Gtk;
6			use Gtk::Gdk;
7
8			use KGS::Protocol;
9			use KGS::Listener::Debug;
10
11			use IO::Socket::INET;
12
13			use Errno;
14
15			init Gtk;
16
17	pcg	1.3	$HACK = 1; # do NEVER enable. ;)
18
19	pcg	1.2	our $config;
20
21	pcg	1.1	{
22			use Storable ();
23			use Scalar::Util ();
24
25			my $staterc = "$ENV{HOME}/.kgsueme";
26
27			my $state = -r $staterc ? Storable::retrieve($staterc) : {};
28			my @widgets;
29
30	pcg	1.2	$config = $state->{config} \|\|= {};
31
32	pcg	1.1	# grr... more gtk+ brokenness
33			my %get = (
34			hpane_position => sub { ($_[0]->children)[0]->allocation->[2] },
35			vpane_position => sub { ($_[0]->children)[0]->allocation->[3] },
36			window_size => sub { [ @{$_[0]->allocation}[2,3] ] },
37			#window_pos => sub { die PApp::Util::dumpval [ $_[0]->get_root_origin ] },
38			clist_column_widths => sub {
39			$_[0]{column_widths};
40			},
41			);
42
43			my %set = (
44			hpane_position => sub { $_[0]->set_position($_[1]) },
45			vpane_position => sub { $_[0]->set_position($_[1]) },
46			window_size => sub { $_[0]->set_default_size(@{$_[1]}) },
47			#window_pos => sub { $_[0]->set_uposition(@{$_[1]}) if @{$_[1]} },
48			clist_column_widths => sub {
49			my ($w, $v) = @_;
50			$v->[$_] && $w->set_column_width($_, $v->[$_]) for 0..$#$v;
51			$w->{column_widths} = $v;
52			$w->signal_connect(resize_column => sub { $v->[$_[1]] = $_[2]; });
53			},
54			);
55
56			sub state {
57			my ($widget, $class, $instance, %attr) = @_;
58
59			while (my ($k, $v) = each %attr) {
60			my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
61			$v = $state->{$class}{""}{$get} if exists $state->{$class}{""}{$get};
62			$v = $state->{$class}{$instance}{$get} if exists $state->{$class}{$instance}{$get};
63			$set{$get} ? $set{$get}->($widget, $v) : $widget->set($set => $v);
64			}
65
66			$widget = [$widget, $class, $instance, \%attr];
67			Scalar::Util::weaken $widget->[0];
68
69			@widgets = (grep $_->[0], @widgets, $widget);
70			}
71
72			sub save_state {
73			for (@widgets) {
74			if ($_->[0]) {
75			my ($widget, $class, $instance, $attr) = @$_;
76			while (my ($k, $v) = each %$attr) {
77			my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
78			$v = $get{$get} ? $get{$get}->($widget) : $widget->get($get);
79
80			$state->{$class}{"*"}{$get} = $v;
81			$state->{$class}{$instance}{$get} = $v;
82			}
83			}
84			::status("save_state", "layout saved");
85			}
86
87			Storable::nstore($state, $staterc);
88			}
89			}
90
91			# make a clist unselectable
92			sub clist_autosort {
93			my $w = shift;
94			my ($c, $o) = (-1);
95			for (0..$w->columns-1) {
96			$w->signal_connect(click_column => sub {
97			if ($_[1] != $c) {
98			$c = $_[1];
99			$o = 0;
100			} else {
101			$o = !$o;
102			}
103			$w->set_sort_column($c);
104			$w->set_sort_type($o ? "descending" : "ascending");
105			$w->sort;
106			});
107			}
108
109			}
110
111			{
112			my $main = new kgsueme;
113
114			my %context_id;
115
116			sub status {
117			my ($type, $text) = @_;
118
119			$main->{status}->pop($context_id{$type}) if $context_id{$type};
120			$main->{status}->push($context_id{$type} \|\|= $main->{status}->get_context_id($type), $text) if $text;
121			}
122			}
123
124			main Gtk;
125
126			#############################################################################
127
128			package kgsueme;
129
130			use base KGS::Listener;
131
132			sub new {
133			my $self = shift;
134			$self = $self->SUPER::new(@_);
135
136			$self->{conn} = new KGS::Protocol;
137
138			KGS::Listener::Debug->new->listen($self->{conn}); #d# debug only :)
139
140			$self->listen($self->{conn});
141
142			$self->{window} = new Gtk::Window 'toplevel';
143			$self->{window}->set_title('kgsueme');
144			::state $self->{window}, "main::window", undef, window_size => [400, 100];
145			$self->{window}->signal_connect(delete_event => sub { main_quit Gtk });
146
147			$self->{window}->add(my $vbox = new Gtk::VBox);
148
149			$vbox->pack_start(($self->{buttonbox} = new Gtk::HButtonBox), 0, 1, 0);
150
151	pcg	1.2	my $button = sub {
152			$self->{buttonbox}->add(my $button = new Gtk::Button $_[0]);
153			signal_connect $button clicked => $_[1];
154			};
155	pcg	1.1
156	pcg	1.2	$button->("Login", sub {
157			$self->login;
158			});
159			$button->("Roomlist", sub {
160	pcg	1.1	$self->{roomlist} \|\|= new roomlist conn => $self->{conn};
161			$self->{roomlist}->show;
162	pcg	1.2	});
163			$button->("Save Config & Layout", sub { ::save_state });
164	pcg	1.1
165			$vbox->pack_start((my $hbox = new Gtk::HBox), 0, 1, 0);
166
167			$hbox->add(new Gtk::Label "Login");
168
169			$hbox->add($self->{login} = new_with_max_length Gtk::Entry 12);
170	pcg	1.2	$self->{login}->set_text($::config->{login});
171	pcg	1.3
172			if ($::HACK) {
173			$self->{login}->signal_connect(activate => sub {
174			$self->{conn}{name} = $self->{login}->get_text;
175			});
176			}
177	pcg	1.1
178			$hbox->add(new Gtk::Label "Password");
179	pcg	1.2	$hbox->add($self->{password} = new Gtk::Entry);
180			$self->{password}->set_visibility(0);
181	pcg	1.1
182			$vbox->pack_start(($self->{status} = new Gtk::Statusbar), 0, 1, 0);
183
184			$self->{window}->show_all;
185
186			$self;
187			}
188
189			sub login {
190			my ($self) = @_;
191
192	pcg	1.2	$self->{conn}->disconnect;
193
194	pcg	1.1	# initialize new socket and connection
195			my $sock = new IO::Socket::INET PeerHost => "kgs.kiseido.com", PeerPort => "2379"
196			or die;
197
198			$sock->blocking(1);
199			$self->{conn}->handshake($sock);
200			$sock->blocking(0);
201
202			my $input; $input = input_add Gtk::Gdk fileno $sock, "read", sub {
203			# this is dorked
204			my $buf;
205			if (0 >= sysread $sock, $buf, 16384
206			and !$!{EINTR} and !$!{EAGAIN}) {
207			input_remove Gtk::Gdk $input;
208			$self->event_disconnect;
209			}
210			$self->{conn}->feed_data($buf);
211			};
212
213			# now login
214	pcg	1.2	$self->{conn}->login($self->{login}->get_text, $self->{password}->get_text);
215	pcg	1.1	}
216
217			sub inject_login {
218			my ($self, $msg) = @_;
219
220			::status("login", "logged in as '$self->{conn}{name}' with status '$msg->{result}'");
221	pcg	1.2	$::config->{login} = $self->{conn}{name};
222	pcg	1.1
223			$self->{window}->show_all;
224			}
225
226			sub event_disconnect { }
227
228			#############################################################################
229
230			package roomlist;
231
232			use base KGS::Listener::Roomlist;
233
234			sub new {
235			my $self = shift;
236			$self = $self->SUPER::new(@_);
237
238			$self->listen($self->{conn});
239
240			$self->{window} = new Gtk::Window 'toplevel';
241			$self->{window}->set_title('KGS Rooms');
242			::state $self->{window}, "roomlist::window", undef, window_size => [400, 200];
243
244			$self->{window}->signal_connect(delete_event => sub { hide $self->{window} });
245
246			$self->{window}->add(my $vbox = new Gtk::VBox);
247
248			$vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
249			$sw->set_policy("automatic", "always");
250
251			$sw->add($self->{roomlist} = new_with_titles Gtk::CList "Group", "Room Name", "Users", "Games", "Flags", "Channel");
252			$self->{roomlist}->set_selection_mode('multiple');
253			::clist_autosort $self->{roomlist};
254			::state $self->{roomlist}, "roomlist::roomlist", undef, clist_column_widths => [20, 200];
255
256			$self->{roomlist}->signal_connect(select_row => sub {
257			my $room = $self->{roomlist}->get_row_data($_[1])
258			or return;
259			$self->{room}{$room->{channel}} \|\|= new room %$room, conn => $self->{conn}, users => {};
260			$self->{room}{$room->{channel}}->join;
261			$self->{roomlist}->unselect_all;
262			});
263
264			$self;
265			}
266
267			sub show {
268			my ($self, $msg) = @_;
269
270			$self->msg(list_rooms => group => $_) for 0..5; # fetch all room names (should not!)
271			$self->{window}->show_all;
272			}
273
274			sub event_update {
275			my ($self) = @_;
276
277			$self->{event_update} \|\|= Gtk->timeout_add(200, sub {
278			my $l = $self->{roomlist};
279
280			$l->freeze;
281			my $pos = $l->get_vadjustment->get_value;
282			$l->clear;
283
284			my $row = 0;
285			for (values %{$self->{rooms}}) {
286			$l->append($_->{group}, $_->{name}, $_->{users}, $_->{games}, $_->{flags}, $_->{channel});
287			$l->set_row_data($row++, $_);
288			}
289			$l->sort;
290			$l->get_vadjustment->set_value($pos);
291			$l->thaw;
292
293			delete $self->{event_update};
294			0;
295			});
296			}
297
298			#############################################################################
299
300			package room;
301
302			use base KGS::Listener::Room;
303
304			sub new {
305			my $self = shift;
306			$self = $self->SUPER::new(@_);
307
308			$self->listen($self->{conn});
309
310			$self->{window} = new Gtk::Window 'toplevel';
311			$self->{window}->set_title("KGS Room $self->{name}");
312			::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400];
313
314			$self->{window}->signal_connect(delete_event => sub { $self->part });
315
316			$self->{window}->add(my $hpane = new Gtk::HPaned);
317			::state $hpane, "room::hpane", $self->{name}, hpane_position => 200;
318
319			$hpane->add(my $vpane = new Gtk::VPaned);
320			::state $vpane, "room::vpane", $self->{name}, vpane_position => 200;
321
322			$vpane->add(my $sw = new Gtk::ScrolledWindow);
323			$sw->set_policy("automatic", "always");
324
325			$sw->add($self->{gamelist} = new_with_titles Gtk::CList "T", "Black", "White", "Rules", "Notes");
326			::clist_autosort $self->{gamelist};
327			::state $self->{gamelist}, "room::gamelist", $self->{name}, clist_column_widths => [20, 120, 120, 120];
328
329			$self->{gamelist}->signal_connect(select_row => sub {
330			my $game = $self->{gamelist}->get_row_data($_[1])
331			or return;
332			$self->{game}{$game->{channel}} \|\|= new game %$game, conn => $self->{conn};
333			$self->{game}{$game->{channel}}->join;
334			$self->{gamelist}->unselect_all;
335			});
336
337			$vpane->add(my $vbox = new Gtk::VBox);
338
339			$vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
340			$sw->set_policy("automatic", "always");
341
342			$sw->add($self->{text} = new Gtk::Text);
343
344			$vbox->pack_start(($self->{entry} = new Gtk::Entry), 0, 1, 0);
345			$self->{entry}->signal_connect(activate => sub {
346			my $text = $self->{entry}->get_text;
347			$self->say($text) if $text =~ /\S/;
348			$self->{entry}->set_text("");
349			});
350
351			$hpane->add(my $sw = new Gtk::ScrolledWindow);
352			$sw->set_policy("automatic", "always");
353
354			$sw->add($self->{userlist} = new_with_titles Gtk::CList "User", "Rank", "Flags");
355			::clist_autosort $self->{userlist};
356			::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];
357
358			$self;
359			}
360
361			sub event_update {
362			my ($self) = @_;
363
364			$self->{event_update} \|\|= Gtk->timeout_add(200, sub {
365			my $l = $self->{userlist};
366
367			$l->freeze;
368			my $pos = $l->get_vadjustment->get_value;
369			$l->clear;
370
371			my $row = 0;
372			for (values %{$self->{users}}) {
373			$l->append($_->{name});
374			$l->set_row_data($row++, $_);
375			}
376			$l->sort;
377			$l->get_vadjustment->set_value($pos);
378			$l->thaw;
379
380			delete $self->{event_update};
381			0;
382			});
383			}
384
385			sub event_update_games {
386			my ($self) = @_;
387
388			$self->{event_update_games} \|\|= Gtk->timeout_add(200, sub {
389			my $l = $self->{gamelist};
390
391			$l->freeze;
392			my $pos = $l->get_vadjustment->get_value;
393			$l->clear;
394
395			my $row = 0;
396			for (values %{$self->{games}}) {
397			$l->append($_->type, $_->user0, $_->user1, $_->rules, $_->notes);
398			$l->set_row_data($row++, $_);
399			}
400			$l->sort;
401			$l->get_vadjustment->set_value($pos);
402			$l->thaw;
403
404			delete $self->{event_update_games};
405			0;
406			});
407			}
408
409			sub join {
410			my ($self) = @_;
411			$self->SUPER::join;
412
413			$self->{window}->show_all;
414			}
415
416			sub part {
417			my ($self) = @_;
418			$self->SUPER::part;
419
420			$self->{window}->hide_all;
421			$self->event_update;
422			$self->event_update_games;
423			}
424
425			sub event_update_roominfo {
426			my ($self) = @_;
427
428			$self->{text}->insert(undef, undef, undef, "$self->{owner}: $self->{description}\n\n");
429			}
430
431			sub inject_msg_room {
432			my ($self, $msg) = @_;
433			return unless $self->{channel} == $msg->{channel};
434
435			$self->{text}->insert(undef, undef, undef, "$msg->{name}: $msg->{message}\n");
436			}
437
438			#############################################################################
439
440			package game;
441
442			use base KGS::Listener::Game;
443			use base KGS::Game;
444
445			sub new {
446			my $self = shift;
447			$self = $self->SUPER::new(@_);
448
449			$self->listen($self->{conn});
450
451			$self->{window} = new Gtk::Window 'toplevel';
452			$self->{window}->set_title("KGS Game ".$self->user0." ".$self->user1);
453			::state $self->{window}, "game::window", undef, window_size => [600, 500];
454
455			$self->{window}->signal_connect(delete_event => sub { $self->part });
456
457			$self->{window}->add(my $hpane = new Gtk::HPaned);
458			::state $hpane, "game::hpane", undef, hpane_position => 500;
459
460			$hpane->add(my $board = new Gtk::Table $self->{size}, $self->{size}, 1);
461
462			for my $x (0 .. $self->{size} - 1) {
463			for my $y (0 .. $self->{size} - 1) {
464			my $cell = new Gtk::Label;
465			$board->attach_defaults($cell, $x, $x + 1, $y, $y + 1);
466			$self->{board}[$x][$y] = $cell;
467			}
468			}
469
470			$hpane->add(my $vpane = new Gtk::VPaned);
471			::state $vpane, "game", $self->{name}, vpane_position => 80;
472
473			$vpane->add(my $sw = new Gtk::ScrolledWindow);
474			$sw->set_policy("automatic", "always");
475
476			$sw->add($self->{userlist} = new_with_titles Gtk::CList "User", "Rank", "Flags");
477			::clist_autosort $self->{userlist};
478			::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];
479
480			$vpane->add(my $vbox = new Gtk::VBox);
481
482			$vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
483			$sw->set_policy("automatic", "always");
484
485			$sw->add($self->{text} = new Gtk::Text);
486
487			$vbox->pack_start(($self->{entry} = new Gtk::Entry), 0, 1, 0);
488			$self->{entry}->signal_connect(activate => sub {
489			my $text = $self->{entry}->get_text;
490			# add message
491			$self->{entry}->set_text("");
492			});
493
494			$self;
495			}
496
497			sub event_update {
498			my ($self) = @_;
499
500			$self->{event_update} \|\|= Gtk->timeout_add(200, sub {
501			my $l = $self->{userlist};
502
503			$l->freeze;
504			my $pos = $l->get_vadjustment->get_value;
505			$l->clear;
506
507			my $row = 0;
508			for (values %{$self->{users}}) {
509			$l->append($_->{name});
510			$l->set_row_data($row++, $_);
511			}
512			$l->sort;
513			$l->get_vadjustment->set_value($pos);
514			$l->thaw;
515
516			delete $self->{event_update};
517			0;
518			});
519			}
520
521			sub join {
522			my ($self) = @_;
523			$self->SUPER::join;
524
525			$self->{window}->show_all;
526			}
527
528			sub part {
529			my ($self) = @_;
530			$self->SUPER::part;
531
532			$self->{window}->hide_all;
533			$self->event_update;
534			}
535
536			sub event_update_tree {
537			my ($self) = @_;
538
539			for my $x (0 .. $self->{size} - 1) {
540			for my $y (0 .. $self->{size} - 1) {
541			$self->{board}[$x][$y]->set_text("");
542			}
543			}
544
545			for (0..$self->{node}) {
546			while (my ($k, $v) = each %{$self->{tree}[$_]}) {
547			if ($k eq "move7") {
548			if ($v->[1] < 255) {
549			$self->{board}[$v->[1]][$v->[2]]->set_text(("X", "O", "-")[$v->[0]]);
550			}
551			}
552			}
553			}
554			}
555
556			1;
557
558
559