kgsueme/kgsueme/app.pl

package app;

use KGS::Protocol::Client;

use Scalar::Util;

use base KGS::Listener;

use Glib::Object::Subclass
   Gtk2::Window;

my %context_id;

our $self;

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

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

sub new {
   my $self = shift;
   $self = $self->Glib::Object::new;

   Scalar::Util::weaken ($::self = $self); # singleton...

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

   $self->listen ($self->{conn}, qw(login userpic idle_warn msg_chat));

   $self->{roomlist} = new roomlist conn => $self->{conn}, app => $self;

   $self->set_title ('kgsueme');
   gtk::state $self, "main::window", undef, window_size => [400, 400];
   $self->signal_connect (destroy => sub { %{$_[0]} = () });
   $self->signal_connect (delete_event => sub { main_quit Gtk2; 1 });

   $self->add (my $vbox = new Gtk2::VBox);

   $vbox->pack_start (($buttonbox = new Gtk2::HButtonBox), 0, 1, 0);
   $buttonbox->set_spacing (0);

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

   $button->("Login", sub { $self->login; });
   $button->("Roomlist", sub { $self->{roomlist}->show; });
   $button->("Save Config & Layout", \&util::save_config);
   $button->("Quit", sub { main_quit Gtk2 });

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

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

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

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

   $self->{gamelist} = new gamelist conn => $self->{conn}, app => $self;
   $vbox->pack_start ($self->{gamelist}->widget, 1, 1, 0);

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

   $self->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"
   my $sock = new IO::Socket::INET PeerHost => $ENV{KGSHOST} || "kgs.kiseido.com", PeerPort => "2379"
      or die "connect: $!";

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

   my $input; $input = add_watch Glib::IO fileno $sock, [G_IO_IN, G_IO_ERR, G_IO_HUP], sub {
      # this is dorked
      my $buf;
      my $len = sysread $sock, $buf, 16384;
      if ($len) {
         $self->{conn}->feed_data($buf);
      } elsif (defined $len || (!$!{EINTR} and !$!{EAGAIN})) {
         warn "disconnected";#d#
         remove Glib::Source $input;
         $self->event_disconnect;
      }
      1;
   }, G_PRIORITY_HIGH;

   # now login
   $ENV{KGSUEME_CLIENTVER} = "1.4.1_01:Swing app:Sun Microsystems Inc."; # he asked for it...#d#
   $self->{conn}->login($ENV{KGSUEME_CLIENTVER} || "kgsueme $VERSION $^O", # allow users to overwrite
                        $self->{login}->get_text,
                        $self->{password}->get_text);
}

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

   $self->{name} = $self->{conn}{name};

   $::config->{login} = $self->{name};

   app::status("login", "logged in as '$self->{name}' with status '$msg->{message}' ('$msg->{reason}')");

   if ($msg->{success}) {
      # auto-join
      $self->open_room (%$_) for values %{$::config->{rooms}};

      sound::play 3, "connect";
   } elsif ($msg->{result} eq "user unknown") {
      sound::play 2, "user_unknown";
   } else {
      sound::play 2, "warning";
   }
}

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

   $self->send ("idle_reset");
}

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

   if ((lc $msg->{name2}) eq (lc $self->{name})) {
      unless ($self->{user}{lc $msg->{name}}) {
         $self->open_user (name => $msg->{name})->inject ($msg);
      }
   }
}

my %userpic;
my %userpic_cb;

# static method to request the userimage and call the cb when it's available.
sub userpic {
   my ($self, $name, $cb) = @_;
   $self->get_userpic ($name, $cb);
}

sub get_userpic {
   my ($self, $name, $cb) = @_;

   if (exists $userpic{$name}) {
      $cb->($userpic{$name});
   } else {
      if (!exists $userpic_cb{$name}) {
         # after 10 seconds, flush callbacks
         $self->send (req_pic => name => $name);
         add Glib::Timeout 10000, sub {
            $_->() for @{delete $userpic_cb{$name} || []};
            0;
         };
      }
      push @{$userpic_cb{$name}}, $cb;
   }
}

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

   $userpic{$msg->{name}} = $msg->{data};
   $_->($userpic{$msg->{name}}) for @{delete $userpic_cb{$msg->{name}} || []};
}

sub event_disconnect { }

sub open_game {
   my ($self, %arg) = @_;

   ($self->{game}{$arg{channel}} ||= new game %arg, conn => $self->{conn}, app => $self)
      ->join;
   Scalar::Util::weaken $self->{game}{$arg{channel}};
   $self->{game}{$arg{channel}};
}

sub open_room {
   my ($self, %arg) = @_;

   ($self->{room}{$arg{channel}} ||= new room %arg, conn => $self->{conn}, app => $self)
      ->join;
   Scalar::Util::weaken $self->{room}{$arg{channel}};
   $self->{room}{$arg{channel}};
}

sub open_user {
   my ($self, %arg) = @_;

   ($self->{user}{lc $arg{name}} ||= new user %arg, conn => $self->{conn}, app => $self)
      ->join;
   Scalar::Util::weaken $self->{user}{lc $arg{name}};
   $self->{user}{lc $arg{name}};
}

sub do_command {
   my ($self, $chat, $cmd, $arg, %arg) = @_;

   if ($cmd eq "say") {
      if (my $context = $arg{game} || $arg{room} || $arg{user}) {
         $context->say ($arg);
      } else {
         $chat->append_text ("\n<error>no context for message</error>");
      }
   } elsif ($cmd eq "whois" or $cmd eq "w") {
      $self->open_user (name => $arg);
   } else {
      $chat->append_text ("\n<error>unknown command</error>");
   }
}

1;

Revision:	1.9
Committed:	Thu May 20 23:09:53 2004 UTC (20 years ago) by pcg
Content type:	text/plain
Branch:	MAIN
Changes since 1.8:	+25 -24 lines
Log Message:	* empty log message *
#	Content
1	package app;
2
3	use KGS::Protocol::Client;
4
5	use Scalar::Util;
6
7	use base KGS::Listener;
8
9	use Glib::Object::Subclass
10	Gtk2::Window;
11
12	my %context_id;
13
14	our $self;
15
16	sub status {
17	my ($type, $text) = @_;
18
19	$::self->{status}->pop ($context_id{$type}) if $context_id{$type};
20	$::self->{status}->push ($context_id{$type} \|\|= $::self->{status}->get_context_id ($type), $text) if $text;
21	}
22
23	sub new {
24	my $self = shift;
25	$self = $self->Glib::Object::new;
26
27	Scalar::Util::weaken ($::self = $self); # singleton...
28
29	$self->{conn} = new KGS::Protocol::Client;
30
31	$self->listen ($self->{conn}, qw(login userpic idle_warn msg_chat));
32
33	$self->{roomlist} = new roomlist conn => $self->{conn}, app => $self;
34
35	$self->set_title ('kgsueme');
36	gtk::state $self, "main::window", undef, window_size => [400, 400];
37	$self->signal_connect (destroy => sub { %{$_[0]} = () });
38	$self->signal_connect (delete_event => sub { main_quit Gtk2; 1 });
39
40	$self->add (my $vbox = new Gtk2::VBox);
41
42	$vbox->pack_start (($buttonbox = new Gtk2::HButtonBox), 0, 1, 0);
43	$buttonbox->set_spacing (0);
44
45	my $button = sub {
46	$buttonbox->add (my $button = new Gtk2::Button $_[0]);
47	signal_connect $button clicked => $_[1];
48	};
49
50	$button->("Login", sub { $self->login; });
51	$button->("Roomlist", sub { $self->{roomlist}->show; });
52	$button->("Save Config & Layout", \&util::save_config);
53	$button->("Quit", sub { main_quit Gtk2 });
54
55	$vbox->pack_start ((my $hbox = new Gtk2::HBox), 0, 1, 0);
56
57	$hbox->add (new Gtk2::Label "Login");
58
59	$hbox->add ($self->{login} = new_with_max_length Gtk2::Entry 12);
60	$self->{login}->set_text ($::config->{login});
61
62	$hbox->add (new Gtk2::Label "Password");
63	$hbox->add ($self->{password} = new Gtk2::Entry);
64	$self->{password}->set_visibility(0);
65
66	$self->{gamelist} = new gamelist conn => $self->{conn}, app => $self;
67	$vbox->pack_start ($self->{gamelist}->widget, 1, 1, 0);
68
69	$vbox->pack_start(($self->{status} = new Gtk2::Statusbar), 0, 1, 0);
70
71	$self->show_all;
72
73	$self;
74	}
75
76	sub login {
77	my ($self) = @_;
78
79	$self->{conn}->disconnect;
80
81	# initialize new socket and connection
82	#my $sock = new IO::Socket::INET PeerHost => "kgs.kiseido.com", PeerPort => "2379"
83	my $sock = new IO::Socket::INET PeerHost => $ENV{KGSHOST} \|\| "kgs.kiseido.com", PeerPort => "2379"
84	or die "connect: $!";
85
86	$sock->blocking(1);
87	$self->{conn}->handshake($sock);
88	$sock->blocking(0);
89
90	my $input; $input = add_watch Glib::IO fileno $sock, [G_IO_IN, G_IO_ERR, G_IO_HUP], sub {
91	# this is dorked
92	my $buf;
93	my $len = sysread $sock, $buf, 16384;
94	if ($len) {
95	$self->{conn}->feed_data($buf);
96	} elsif (defined $len \|\| (!$!{EINTR} and !$!{EAGAIN})) {
97	warn "disconnected";#d#
98	remove Glib::Source $input;
99	$self->event_disconnect;
100	}
101	1;
102	}, G_PRIORITY_HIGH;
103
104	# now login
105	$ENV{KGSUEME_CLIENTVER} = "1.4.1_01:Swing app:Sun Microsystems Inc."; # he asked for it...#d#
106	$self->{conn}->login($ENV{KGSUEME_CLIENTVER} \|\| "kgsueme $VERSION $^O", # allow users to overwrite
107	$self->{login}->get_text,
108	$self->{password}->get_text);
109	}
110
111	sub inject_login {
112	my ($self, $msg) = @_;
113
114	$self->{name} = $self->{conn}{name};
115
116	$::config->{login} = $self->{name};
117
118	app::status("login", "logged in as '$self->{name}' with status '$msg->{message}' ('$msg->{reason}')");
119
120	if ($msg->{success}) {
121	# auto-join
122	$self->open_room (%$_) for values %{$::config->{rooms}};
123
124	sound::play 3, "connect";
125	} elsif ($msg->{result} eq "user unknown") {
126	sound::play 2, "user_unknown";
127	} else {
128	sound::play 2, "warning";
129	}
130	}
131
132	sub inject_idle_warn {
133	my ($self, $msg) = @_;
134
135	$self->send ("idle_reset");
136	}
137
138	sub inject_msg_chat {
139	my ($self, $msg) = @_;
140
141	if ((lc $msg->{name2}) eq (lc $self->{name})) {
142	unless ($self->{user}{lc $msg->{name}}) {
143	$self->open_user (name => $msg->{name})->inject ($msg);
144	}
145	}
146	}
147
148	my %userpic;
149	my %userpic_cb;
150
151	# static method to request the userimage and call the cb when it's available.
152	sub userpic {
153	my ($self, $name, $cb) = @_;
154	$self->get_userpic ($name, $cb);
155	}
156
157	sub get_userpic {
158	my ($self, $name, $cb) = @_;
159
160	if (exists $userpic{$name}) {
161	$cb->($userpic{$name});
162	} else {
163	if (!exists $userpic_cb{$name}) {
164	# after 10 seconds, flush callbacks
165	$self->send (req_pic => name => $name);
166	add Glib::Timeout 10000, sub {
167	$_->() for @{delete $userpic_cb{$name} \|\| []};
168	0;
169	};
170	}
171	push @{$userpic_cb{$name}}, $cb;
172	}
173	}
174
175	sub inject_userpic {
176	my ($self, $msg) = @_;
177
178	$userpic{$msg->{name}} = $msg->{data};
179	$_->($userpic{$msg->{name}}) for @{delete $userpic_cb{$msg->{name}} \|\| []};
180	}
181
182	sub event_disconnect { }
183
184	sub open_game {
185	my ($self, %arg) = @_;
186
187	($self->{game}{$arg{channel}} \|\|= new game %arg, conn => $self->{conn}, app => $self)
188	->join;
189	Scalar::Util::weaken $self->{game}{$arg{channel}};
190	$self->{game}{$arg{channel}};
191	}
192
193	sub open_room {
194	my ($self, %arg) = @_;
195
196	($self->{room}{$arg{channel}} \|\|= new room %arg, conn => $self->{conn}, app => $self)
197	->join;
198	Scalar::Util::weaken $self->{room}{$arg{channel}};
199	$self->{room}{$arg{channel}};
200	}
201
202	sub open_user {
203	my ($self, %arg) = @_;
204
205	($self->{user}{lc $arg{name}} \|\|= new user %arg, conn => $self->{conn}, app => $self)
206	->join;
207	Scalar::Util::weaken $self->{user}{lc $arg{name}};
208	$self->{user}{lc $arg{name}};
209	}
210
211	sub do_command {
212	my ($self, $chat, $cmd, $arg, %arg) = @_;
213
214	if ($cmd eq "say") {
215	if (my $context = $arg{game} \|\| $arg{room} \|\| $arg{user}) {
216	$context->say ($arg);
217	} else {
218	$chat->append_text ("\n<error>no context for message</error>");
219	}
220	} elsif ($cmd eq "whois" or $cmd eq "w") {
221	$self->open_user (name => $arg);
222	} else {
223	$chat->append_text ("\n<error>unknown command</error>");
224	}
225	}
226
227	1;
228