| … | |
… | |
| 15 | Gtk2::Label; |
15 | Gtk2::Label; |
| 16 | |
16 | |
| 17 | sub INIT_INSTANCE { |
17 | sub INIT_INSTANCE { |
| 18 | my $self = shift; |
18 | my $self = shift; |
| 19 | |
19 | |
|
|
20 | $self->signal_connect (destroy => sub { |
|
|
21 | $_[0]->stop; |
|
|
22 | }); |
|
|
23 | |
| 20 | $self->{set} = sub { }; |
24 | $self->{set} = sub { }; |
| 21 | $self->{format} = sub { "ERROR" }; |
25 | $self->{format} = sub { "ERROR" }; |
| 22 | } |
|
|
| 23 | |
|
|
| 24 | sub FINALIZE_INSTANCE { |
|
|
| 25 | my ($self) = @_; |
|
|
| 26 | print "finalize(clock)\n";#d# |
|
|
| 27 | $self->stop; |
|
|
| 28 | } |
26 | } |
| 29 | |
27 | |
| 30 | sub configure { |
28 | sub configure { |
| 31 | my ($self, $timesys, $main, $interval, $count) = @_; |
29 | my ($self, $timesys, $main, $interval, $count) = @_; |
| 32 | |
30 | |
| … | |
… | |
| 183 | $self->{info}->set_text ("$captures pris."); |
181 | $self->{info}->set_text ("$captures pris."); |
| 184 | } |
182 | } |
| 185 | |
183 | |
| 186 | package game; |
184 | package game; |
| 187 | |
185 | |
|
|
186 | use Scalar::Util qw(weaken); |
|
|
187 | |
| 188 | use KGS::Constants; |
188 | use KGS::Constants; |
| 189 | use KGS::Game::Board; |
189 | use KGS::Game::Board; |
| 190 | |
190 | |
| 191 | use Gtk2::GoBoard; |
191 | use Gtk2::GoBoard; |
| 192 | |
192 | |
|
|
193 | use Glib::Object::Subclass |
|
|
194 | Gtk2::Window; |
|
|
195 | |
| 193 | use base KGS::Listener::Game; |
196 | use base KGS::Listener::Game; |
| 194 | use base KGS::Game; |
197 | use base KGS::Game; |
| 195 | |
198 | |
| 196 | use base gtk::widget; |
|
|
| 197 | |
|
|
| 198 | use POSIX qw(ceil); |
199 | use POSIX qw(ceil); |
| 199 | |
200 | |
| 200 | sub new { |
201 | sub new { |
| 201 | my $self = shift; |
202 | my ($self, %arg) = @_; |
| 202 | $self = $self->SUPER::new(@_); |
|
|
| 203 | |
203 | |
|
|
204 | $self = $self->Glib::Object::new; |
|
|
205 | $self->{$_} = delete $arg{$_} for keys %arg; |
|
|
206 | |
| 204 | $self->listen($self->{conn}); |
207 | $self->listen ($self->{conn}); |
| 205 | |
208 | |
| 206 | $self->{window} = new Gtk2::Window 'toplevel'; |
|
|
| 207 | gtk::state $self->{window}, "game::window", undef, window_size => [600, 500]; |
209 | gtk::state $self, "game::window", undef, window_size => [600, 500]; |
| 208 | |
210 | |
| 209 | $self->{window}->signal_connect(delete_event => sub { |
211 | $self->signal_connect (delete_event => sub { $self->part; 1 }); |
| 210 | $self->part; |
212 | $self->signal_connect (destroy => sub { %{$_[0]} = () }); |
| 211 | $self->destroy; |
|
|
| 212 | 1; |
|
|
| 213 | }); |
|
|
| 214 | |
213 | |
| 215 | $self->{window}->add($self->{hpane} = new Gtk2::HPaned); |
214 | $self->add (my $hpane = new Gtk2::HPaned); |
| 216 | gtk::state $self->{hpane}, "game::hpane", undef, position => 500; |
215 | gtk::state $hpane, "game::hpane", undef, position => 500; |
| 217 | |
216 | |
| 218 | # LEFT PANE |
217 | # LEFT PANE |
| 219 | |
218 | |
| 220 | $self->{hpane}->pack1(($self->{left} = new Gtk2::VBox), 1, 0); |
219 | $hpane->pack1 (($self->{left} = new Gtk2::VBox), 1, 0); |
| 221 | |
220 | |
| 222 | $self->{boardbox} = new Gtk2::VBox; |
221 | $self->{boardbox} = new Gtk2::VBox; |
| 223 | |
222 | |
| 224 | $self->{hpane}->pack1((my $vbox = new Gtk2::VBox), 1, 1); |
223 | $hpane->pack1((my $vbox = new Gtk2::VBox), 1, 1); |
| 225 | |
224 | |
| 226 | # challenge |
225 | # challenge |
| 227 | |
226 | |
| 228 | $self->{challenge} = new challenge channel => $self->{channel}; |
227 | $self->{challenge} = new challenge channel => $self->{channel}; |
| 229 | |
228 | |
| … | |
… | |
| 250 | |
249 | |
| 251 | $self->{boardbox}->add ($self->{board} = new Gtk2::GoBoard size => $self->{size}); |
250 | $self->{boardbox}->add ($self->{board} = new Gtk2::GoBoard size => $self->{size}); |
| 252 | |
251 | |
| 253 | # RIGHT PANE |
252 | # RIGHT PANE |
| 254 | |
253 | |
| 255 | $self->{hpane}->pack2(($self->{vpane} = new Gtk2::VPaned), 1, 1); |
254 | $hpane->pack2 (($self->{vpane} = new Gtk2::VPaned), 1, 1); |
| 256 | $self->{hpane}->set(position_set => 1); |
255 | $hpane->set (position_set => 1); |
| 257 | gtk::state $self->{vpane}, "game::vpane", $self->{name}, position => 80; |
256 | gtk::state $self->{vpane}, "game::vpane", $self->{name}, position => 80; |
| 258 | |
257 | |
| 259 | $self->{vpane}->add(my $sw = new Gtk2::ScrolledWindow); |
258 | $self->{vpane}->add (my $sw = new Gtk2::ScrolledWindow); |
| 260 | $sw->set_policy("automatic", "always"); |
259 | $sw->set_policy ("automatic", "always"); |
| 261 | |
260 | |
| 262 | $sw->add(($self->{userlist} = new userlist)->widget); |
261 | $sw->add ($self->{userlist} = new userlist); |
| 263 | |
262 | |
| 264 | $self->{vpane}->add(my $vbox = new Gtk2::VBox); |
263 | $self->{vpane}->add (my $vbox = new Gtk2::VBox); |
| 265 | |
264 | |
| 266 | $vbox->pack_start((my $hbox = new Gtk2::HBox 1), 0, 1, 0); |
265 | $vbox->pack_start ((my $hbox = new Gtk2::HBox 1), 0, 1, 0); |
| 267 | |
266 | |
| 268 | for (COLOUR_WHITE, COLOUR_BLACK) { |
|
|
| 269 | $hbox->add ($self->{userpanel}[$_] = new game::userpanel colour => $_); |
267 | $hbox->add ($self->{userpanel}[$_] = new game::userpanel colour => $_) |
| 270 | Scalar::Util::weaken $self->{userpanel}[$_]; |
268 | for COLOUR_WHITE, COLOUR_BLACK; |
| 271 | } |
269 | |
| 272 | |
|
|
| 273 | $vbox->pack_start(($self->{chat} = new chat), 1, 1, 0); |
270 | $vbox->pack_start (($self->{chat} = new chat), 1, 1, 0); |
|
|
271 | weaken $self->{chat}; |
| 274 | |
272 | |
| 275 | $self->{chat}->signal_connect(command => sub { |
273 | $self->{chat}->signal_connect (command => sub { |
| 276 | my ($chat, $cmd, $arg) = @_; |
274 | my ($chat, $cmd, $arg) = @_; |
| 277 | if ($cmd eq "rsave") { |
275 | if ($cmd eq "rsave") { |
| 278 | Storable::nstore { tree => $self->{tree}, curnode => $self->{curnode}, move => $self->{move} }, $arg;#d# |
276 | Storable::nstore { tree => $self->{tree}, curnode => $self->{curnode}, move => $self->{move} }, $arg;#d# |
| 279 | } else { |
277 | } else { |
| 280 | $self->{app}->do_command ($chat, $cmd, $arg, userlist => $self->{userlist}, game => $self); |
278 | $self->{app}->do_command ($chat, $cmd, $arg, userlist => $self->{userlist}, game => $self); |
| 281 | } |
279 | } |
| 282 | }); |
280 | }); |
| 283 | |
281 | |
| 284 | $self->event_update_game; |
|
|
| 285 | $self; |
282 | $self; |
| 286 | } |
283 | } |
| 287 | |
284 | |
| 288 | sub event_update_users { |
285 | sub event_update_users { |
| 289 | my ($self, $add, $update, $remove) = @_; |
286 | my ($self, $add, $update, $remove) = @_; |
| … | |
… | |
| 312 | my ($self) = @_; |
309 | my ($self) = @_; |
| 313 | return if $self->{joined}; |
310 | return if $self->{joined}; |
| 314 | |
311 | |
| 315 | $self->SUPER::join; |
312 | $self->SUPER::join; |
| 316 | |
313 | |
| 317 | $self->{window}->show_all; |
314 | $self->show_all; |
| 318 | } |
|
|
| 319 | |
|
|
| 320 | sub part { |
|
|
| 321 | my ($self) = @_; |
|
|
| 322 | |
|
|
| 323 | $self->SUPER::part; |
|
|
| 324 | $self->destroy; |
|
|
| 325 | } |
315 | } |
| 326 | |
316 | |
| 327 | sub update_board { |
317 | sub update_board { |
| 328 | my ($self) = @_; |
318 | my ($self) = @_; |
| 329 | return unless $self->{path}; |
319 | return unless $self->{path}; |
| … | |
… | |
| 406 | $self->{chat}->append_text ($text); |
396 | $self->{chat}->append_text ($text); |
| 407 | } |
397 | } |
| 408 | |
398 | |
| 409 | sub event_join { |
399 | sub event_join { |
| 410 | my ($self) = @_; |
400 | my ($self) = @_; |
|
|
401 | |
| 411 | $self->SUPER::event_join; |
402 | $self->SUPER::event_join (@_); |
|
|
403 | $self->event_update_game; |
| 412 | } |
404 | } |
| 413 | |
405 | |
| 414 | sub event_part { |
406 | sub event_part { |
| 415 | my ($self) = @_; |
407 | my ($self) = @_; |
|
|
408 | |
| 416 | $self->SUPER::event_part; |
409 | $self->SUPER::event_part; |
| 417 | $self->destroy; |
410 | $self->destroy; |
| 418 | } |
411 | } |
| 419 | |
412 | |
| 420 | sub event_move { |
413 | sub event_move { |
| … | |
… | |
| 424 | |
417 | |
| 425 | sub event_update_game { |
418 | sub event_update_game { |
| 426 | my ($self) = @_; |
419 | my ($self) = @_; |
| 427 | $self->SUPER::event_update_game; |
420 | $self->SUPER::event_update_game; |
| 428 | |
421 | |
| 429 | return unless $self->{window}; |
422 | return unless $self->{joined}; |
| 430 | |
423 | |
| 431 | my $title = defined $self->{channel} |
424 | my $title = defined $self->{channel} |
| 432 | ? $self->owner->as_string . " " . $self->opponent_string |
425 | ? $self->owner->as_string . " " . $self->opponent_string |
| 433 | : "Game Window"; |
426 | : "Game Window"; |
| 434 | $self->{window}->set_title("KGS Game $title"); |
427 | $self->set_title("KGS Game $title"); |
| 435 | $self->{title}->set_text ($title); |
428 | $self->{title}->set_text ($title); |
| 436 | |
429 | |
| 437 | $self->{user}[COLOUR_BLACK] = $self->{user1}; |
430 | $self->{user}[COLOUR_BLACK] = $self->{user1}; |
| 438 | $self->{user}[COLOUR_WHITE] = $self->{user2}; |
431 | $self->{user}[COLOUR_WHITE] = $self->{user2}; |
| 439 | |
432 | |
| … | |
… | |
| 492 | } |
485 | } |
| 493 | |
486 | |
| 494 | sub event_update_rules { |
487 | sub event_update_rules { |
| 495 | my ($self, $rules) = @_; |
488 | my ($self, $rules) = @_; |
| 496 | |
489 | |
|
|
490 | if ($self->{user}) { |
| 497 | $self->{userpanel}[$_]->configure ($self->{app}, $self->{user}[$_], $rules) |
491 | $self->{userpanel}[$_]->configure ($self->{app}, $self->{user}[$_], $rules) |
| 498 | for COLOUR_BLACK, COLOUR_WHITE; |
492 | for COLOUR_BLACK, COLOUR_WHITE; |
|
|
493 | } |
| 499 | |
494 | |
| 500 | sound::play 3, "gamestart"; |
495 | sound::play 3, "gamestart"; |
| 501 | |
496 | |
| 502 | my $text = "\n<header>Game Rules</header>"; |
497 | my $text = "\n<header>Game Rules</header>"; |
| 503 | |
498 | |
| … | |
… | |
| 547 | |
542 | |
| 548 | use KGS::Listener::Debug; |
543 | use KGS::Listener::Debug; |
| 549 | $self->{chat}->append_text ("\n".KGS::Listener::Debug::dumpval($challenge)); |
544 | $self->{chat}->append_text ("\n".KGS::Listener::Debug::dumpval($challenge)); |
| 550 | } |
545 | } |
| 551 | |
546 | |
| 552 | sub destroy { |
|
|
| 553 | my ($self) = @_; |
|
|
| 554 | |
|
|
| 555 | delete $self->{app}{gamelist}{game}{$self->{channel}}; |
|
|
| 556 | $self->SUPER::destroy; |
|
|
| 557 | } |
|
|
| 558 | |
|
|
| 559 | 1; |
547 | 1; |
| 560 | |
548 | |
