ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/kgsueme/app.pl
Revision: 1.15
Committed: Sun May 30 19:21:45 2004 UTC (20 years ago) by root
Content type: text/plain
Branch: MAIN
Changes since 1.14: +8 -5 lines
Log Message:
*** empty log message ***

File Contents

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