ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/bin/kgsueme
(Generate patch)

Comparing kgsueme/bin/kgsueme (file contents):
Revision 1.8 by pcg, Thu May 29 08:02:31 2003 UTC vs.
Revision 1.60 by pcg, Sat May 29 06:38:24 2004 UTC

1#!/usr/bin/perl -I../lib/ 1#!/usr/bin/perl
2 2
3#use PApp::Util qw(dumpval); # debug only 3use Glib;
4
5use Gtk; 4use Gtk2;
6use Gtk::Gdk;
7#use Gtk::Gdk::Pixbuf;
8use Gtk::Gdk::ImlibImage;
9
10use Gnome;
11 5
12use KGS::Protocol; 6use KGS::Protocol;
13use KGS::Listener::Debug; 7use KGS::Listener::Debug;
14 8
9use Audio::Data;
10use Audio::Play;
11
15use IO::Socket::INET; 12use IO::Socket::INET;
16 13use List::Util;
17use Errno; 14use Errno;
18 15
19init Gnome "kgsueme"; 16use Storable;
17use Carp;
20 18
21$HACK = 1; # do NEVER enable. ;) 19init Gtk2;
22 20
23our $config; 21$SIG{QUIT} = sub { Carp::confess "SIGQUIT" };
24our $IMGDIR = "images";
25 22
26sub load_img { 23our $HACK = 1; # do NEVER enable. ;)
27# new_from_file Gtk::Gdk::Pixbuf "$IMGDIR/$_[0]" 24our $DEBUG_EXPOSE = 0;
28 load_image Gtk::Gdk::ImlibImage "$IMGDIR/$_[0]" 25
29 or die "$IMGDIR/$_[0]: $!"; 26if ($HACK) {
27 $KGS::debug = 1;
30} 28}
31 29
32our @black_img = load_img "b-01.png"; 30BEGIN {
33our @white_img = map +(load_img "w-0$_.png"), 1,2,3,4,5; 31 our $VERSION = "0.1";
34our $board_img = load_img "woodgrain-01.jpg";
35 32
36{ 33 our $config;
37 use Storable (); 34 our $LIBDIR = ".";
38 use Scalar::Util ();
39 35
40 my $staterc = "$ENV{HOME}/.kgsueme"; 36 use KGS::Constants;
41 37
42 my $state = -r $staterc ? Storable::retrieve($staterc) : {}; 38 for (qw(util.pl gtk.pl chat.pl superchat.pl sound.pl user.pl gamelist.pl userlist.pl challenge.pl
43 my @widgets; 39 game.pl room.pl roomlist.pl app.pl)) {
44 40 require (KGS::Constants::findfile "KGS/kgsueme/$_");
45 $config = $state->{config} ||= {}; 41 die if $@;
46
47 # grr... more gtk+ brokenness
48 my %get = (
49 hpane_position => sub { ($_[0]->children)[0]->allocation->[2] },
50 vpane_position => sub { ($_[0]->children)[0]->allocation->[3] },
51 window_size => sub { [ @{$_[0]->allocation}[2,3] ] },
52 #window_pos => sub { die PApp::Util::dumpval [ $_[0]->get_root_origin ] },
53 clist_column_widths => sub {
54 $_[0]{column_widths};
55 },
56 );
57
58 my %set = (
59 hpane_position => sub { $_[0]->set_position($_[1]) },
60 vpane_position => sub { $_[0]->set_position($_[1]) },
61 window_size => sub { $_[0]->set_default_size(@{$_[1]}) },
62 #window_pos => sub { $_[0]->set_uposition(@{$_[1]}) if @{$_[1]} },
63 clist_column_widths => sub {
64 my ($w, $v) = @_;
65 $v->[$_] && $w->set_column_width($_, $v->[$_]) for 0..$#$v;
66 $w->{column_widths} = $v;
67 $w->signal_connect(resize_column => sub { $v->[$_[1]] = $_[2]; });
68 },
69 );
70
71 sub state {
72 my ($widget, $class, $instance, %attr) = @_;
73
74 while (my ($k, $v) = each %attr) {
75 my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
76 $v = $state->{$class}{"*"}{$get} if exists $state->{$class}{"*"}{$get};
77 $v = $state->{$class}{$instance}{$get} if exists $state->{$class}{$instance}{$get};
78 $set{$get} ? $set{$get}->($widget, $v) : $widget->set($set => $v);
79 }
80
81 $widget = [$widget, $class, $instance, \%attr];
82 Scalar::Util::weaken $widget->[0];
83
84 @widgets = (grep $_->[0], @widgets, $widget);
85 }
86
87 sub save_state {
88 for (@widgets) {
89 if ($_->[0]) {
90 my ($widget, $class, $instance, $attr) = @$_;
91
92 $widget->realize;
93
94 while (my ($k, $v) = each %$attr) {
95 my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
96 $v = $get{$get} ? $get{$get}->($widget) : $widget->get($get);
97
98 $state->{$class}{"*"}{$get} = $v;
99 $state->{$class}{$instance}{$get} = $v;
100 }
101 }
102 ::status("save_state", "layout saved");
103 }
104
105 Storable::nstore($state, $staterc);
106 } 42 }
107} 43}
108 44
109# make a clist unselectable 45if ($ENV{KGSUEME_DEBUG}) {
110sub clist_autosort { 46 use KGS::Constants;
111 my $w = shift; 47
112 my ($c, $o) = (-1); 48 for (19) {
113 for (0..$w->columns-1) { 49 my $game = new game size => $_;
114 $w->signal_connect(click_column => sub { 50
115 if ($_[1] != $c) { 51 $game->event_challenge (
116 $c = $_[1]; 52bless( {
117 $o = 0; 53 type => 0,
118 } else { 54 user1 => bless( {
119 $o = !$o; 55 flags => 2633,
56 name => 'dorkusx'
57 }, 'KGS::User' ),
58 rules => bless( {
59 count => 5,
60 time => 900,
61 timesys => 2,
62 interval => 30,
63 komi => '6.5',
64 size => 19,
65 ruleset => 0,
66 handicap => 2,
67 }, 'KGS::Rules' ),
68 user2 => bless( {
69 flags => 436220808,
70 name => 'Nerdamus'
71 }, 'KGS::User' )
72 }, 'KGS::Challenge' ));
73
74
75 if (0) {
76 my $data = Storable::retrieve "board2.dat";
77 while (my ($k, $v) = each %$data) {
78 $game->{$k} = $v;
120 } 79 }
121 $w->set_sort_column($c); 80 $game->event_update_tree;
122 $w->set_sort_type($o ? "descending" : "ascending");
123 $w->sort;
124 }); 81 }
82
83 if (0) {
84 $game->{cur_board} = new KGS::Game::Board;
85 my @x = (
86 #MARK_B,
87 #MARK_W,
88 #MARK_GRAY_B | MARK_SMALL_W,
89 #MARK_GRAY_W | MARK_SMALL_B,
90 #MARK_W | MARK_TRIANGLE,
91 0, 0, 0,
92 );
93 for $x (0..18) {
94 for $y (0..18) {
95 $game->{cur_board}{board}[$x][$y] =
96 $x[rand @x];
97 }
98 }
99
100 $game->{cur_board}{board}[0][0] = MARK_B;
101 $game->{cur_board}{board}[1][1] = MARK_GRAY_B | MARK_SMALL_W;
102 $game->{cur_board}{board}[2][2] = MARK_W | MARK_TRIANGLE;
103 $game->{cur_board}{board}[1][2] = MARK_B | MARK_LABEL;
104 $game->{cur_board}{label}[1][2] = "198";
105 $game->{cur_board}{board}[0][2] = MARK_W | MARK_LABEL;
106 $game->{cur_board}{label}[0][2] = "AWA";
107 $game->{board}->set_board ($game->{cur_board});
108 }
125 } 109 }
126 110 main Gtk2;
111
127} 112}
128 113
129{ 114our $app = new app;
130 my $main = new kgsueme;
131 115
132 my %context_id; 116main Gtk2;
133 117
134 sub status { 118$app->destroy;
135 my ($type, $text) = @_;
136 119
137 $main->{status}->pop($context_id{$type}) if $context_id{$type}; 120Gtk2->main_iteration while Gtk2->events_pending;
138 $main->{status}->push($context_id{$type} ||= $main->{status}->get_context_id($type), $text) if $text;
139 }
140}
141
142main Gtk;
143
144#############################################################################
145
146package kgsueme;
147
148use base KGS::Listener;
149
150sub new {
151 my $self = shift;
152 $self = $self->SUPER::new(@_);
153
154 $self->{conn} = new KGS::Protocol;
155
156 KGS::Listener::Debug->new->listen($self->{conn}); #d# debug only :)
157
158 $self->listen($self->{conn});
159
160 $self->{roomlist} = new roomlist conn => $self->{conn};
161
162 $self->{window} = new Gtk::Window 'toplevel';
163 $self->{window}->set_title('kgsueme');
164 ::state $self->{window}, "main::window", undef, window_size => [400, 100];
165 $self->{window}->signal_connect(delete_event => sub { main_quit Gtk; 1 });
166
167 $self->{window}->add(my $vbox = new Gtk::VBox);
168
169 $vbox->pack_start(($buttonbox = new Gtk::HButtonBox), 0, 1, 0);
170 $buttonbox->set_spacing(0);
171
172 my $button = sub {
173 $buttonbox->add(my $button = new Gtk::Button $_[0]);
174 signal_connect $button clicked => $_[1];
175 };
176
177 $button->("Login", sub { $self->login; });
178 $button->("Roomlist", sub { $self->{roomlist}->show; });
179 $button->("Save Config & Layout", sub { ::save_state });
180 $button->("Quit", sub { main_quit Gtk });
181
182 $vbox->pack_start((my $hbox = new Gtk::HBox), 0, 1, 0);
183
184 $hbox->add(new Gtk::Label "Login");
185
186 $hbox->add($self->{login} = new_with_max_length Gtk::Entry 12);
187 $self->{login}->set_text($::config->{login});
188
189 if ($::HACK) {
190 $self->{login}->signal_connect(activate => sub {
191 $self->{conn}{name} = $self->{login}->get_text;
192 });
193 }
194
195 $hbox->add(new Gtk::Label "Password");
196 $hbox->add($self->{password} = new Gtk::Entry);
197 $self->{password}->set_visibility(0);
198
199 $vbox->pack_start(($self->{status} = new Gtk::Statusbar), 0, 1, 0);
200
201 $self->{window}->show_all;
202
203 $self;
204}
205
206sub login {
207 my ($self) = @_;
208
209 $self->{conn}->disconnect;
210
211 # initialize new socket and connection
212 my $sock = new IO::Socket::INET PeerHost => "kgs.kiseido.com", PeerPort => "2379"
213 or die;
214
215 $sock->blocking(1);
216 $self->{conn}->handshake($sock);
217 $sock->blocking(0);
218
219 my $input; $input = input_add Gtk::Gdk fileno $sock, "read", sub {
220 # this is dorked
221 my $buf;
222 if (0 >= sysread $sock, $buf, 16384
223 and !$!{EINTR} and !$!{EAGAIN}) {
224 input_remove Gtk::Gdk $input;
225 $self->event_disconnect;
226 }
227 $self->{conn}->feed_data($buf);
228 };
229
230 # now login
231 $self->{conn}->login($self->{login}->get_text, $self->{password}->get_text);
232}
233
234sub inject_login {
235 my ($self, $msg) = @_;
236
237 ::status("login", "logged in as '$self->{conn}{name}' with status '$msg->{result}'");
238 $::config->{login} = $self->{conn}{name};
239
240 if ($msg->{success}) {
241 for (keys %{$::config->{rooms}}) {
242 $self->{roomlist}->join_room($_);
243 }
244 }
245
246 warn PApp::Util::dumpval($::config);
247}
248
249sub event_disconnect { }
250
251#############################################################################
252
253package roomlist;
254
255use base KGS::Listener::Roomlist;
256
257sub new {
258 my $self = shift;
259 $self = $self->SUPER::new(@_);
260
261 $self->listen($self->{conn});
262
263 $self->{window} = new Gtk::Window 'toplevel';
264 $self->{window}->set_title('KGS Rooms');
265 ::state $self->{window}, "roomlist::window", undef, window_size => [400, 200];
266
267 $self->{window}->signal_connect(delete_event => sub { $self->{window}->hide; 1 });
268
269 $self->{window}->add(my $vbox = new Gtk::VBox);
270
271 $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
272 $sw->set_policy("automatic", "always");
273
274 $sw->add($self->{roomlist} = new_with_titles Gtk::CList "Group", "Room Name", "Users", "Games", "Flags", "Channel");
275 $self->{roomlist}->set_selection_mode('multiple');
276 ::clist_autosort $self->{roomlist};
277 ::state $self->{roomlist}, "roomlist::roomlist", undef, clist_column_widths => [20, 200];
278
279 $self->{roomlist}->signal_connect(select_row => sub {
280 my $room = $self->{roomlist}->get_row_data($_[1])
281 or return;
282 $self->{roomlist}->unselect_all;
283 $self->join_room($room->{channel});
284 });
285
286 $self;
287}
288
289sub join_room {
290 my ($self, $channel) = @_;
291
292 $self->{room}{$channel} ||= room->new(channel => $channel, conn => $self->{conn}, users => {});
293 $self->{room}{$channel}->join;
294}
295
296sub show {
297 my ($self, $msg) = @_;
298
299 $self->msg(list_rooms => group => $_) for 0..5; # fetch all room names (should not!)
300 $self->{window}->show_all;
301}
302
303sub event_update {
304 my ($self) = @_;
305
306 $self->{event_update} ||= Gtk->timeout_add(200, sub {
307 my $l = $self->{roomlist};
308
309 $l->freeze;
310 my $pos = $l->get_vadjustment->get_value;
311 $l->clear;
312
313 my $row = 0;
314 for (values %{$self->{rooms}}) {
315 $l->append($_->{group}, $_->{name}, $_->{users}, $_->{games}, $_->{flags}, $_->{channel});
316 $l->set_row_data($row++, $_);
317 }
318 $l->sort;
319 $l->get_vadjustment->set_value($pos);
320 $l->thaw;
321
322 delete $self->{event_update};
323 0;
324 });
325}
326
327#############################################################################
328
329package room;
330
331use base KGS::Listener::Room;
332
333sub new {
334 my $self = shift;
335 $self = $self->SUPER::new(@_);
336
337 $self->listen($self->{conn});
338
339 $self->{window} = new Gtk::Window 'toplevel';
340 $self->{window}->set_title("KGS Room $self->{name}");
341 ::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400];
342
343 $self->{window}->signal_connect(delete_event => sub { $self->part; 1 });
344
345 $self->{window}->add(my $hpane = new Gtk::HPaned);
346 ::state $hpane, "room::hpane", $self->{name}, hpane_position => 200;
347
348 $hpane->add(my $vpane = new Gtk::VPaned);
349 ::state $vpane, "room::vpane", $self->{name}, vpane_position => 200;
350
351 $vpane->add(my $sw = new Gtk::ScrolledWindow);
352 $sw->set_policy("automatic", "always");
353
354 $sw->add($self->{gamelist} = new_with_titles Gtk::CList "T", "Black", "White", "Rules", "Notes");
355 ::clist_autosort $self->{gamelist};
356 ::state $self->{gamelist}, "room::gamelist", $self->{name}, clist_column_widths => [20, 120, 120, 120];
357
358 $self->{gamelist}->signal_connect(select_row => sub {
359 my $game = $self->{gamelist}->get_row_data($_[1])
360 or return;
361 $self->{game}{$game->{channel}} ||= new game %$game, conn => $self->{conn};
362 $self->{game}{$game->{channel}}->join;
363 $self->{gamelist}->unselect_all;
364 });
365
366 $vpane->add(my $vbox = new Gtk::VBox);
367
368 $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
369 $sw->set_policy("automatic", "always");
370
371 $sw->add($self->{text} = new Gtk::Text);
372
373 $vbox->pack_start(($self->{entry} = new Gtk::Entry), 0, 1, 0);
374 $self->{entry}->signal_connect(activate => sub {
375 my $text = $self->{entry}->get_text;
376 $self->say($text) if $text =~ /\S/;
377 $self->{entry}->set_text("");
378 });
379
380 $hpane->add(my $sw = new Gtk::ScrolledWindow);
381 $sw->set_policy("automatic", "always");
382
383 $sw->add($self->{userlist} = new_with_titles Gtk::CList "User", "Rank", "Flags");
384 ::clist_autosort $self->{userlist};
385 ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];
386
387 $self;
388}
389
390sub event_update {
391 my ($self) = @_;
392
393 $self->{event_update} ||= Gtk->timeout_add(200, sub {
394 my $l = $self->{userlist};
395
396 $l->freeze;
397 my $pos = $l->get_vadjustment->get_value;
398 $l->clear;
399
400 my $row = 0;
401 for (values %{$self->{users}}) {
402 $l->append($_->{name});
403 $l->set_row_data($row++, $_);
404 }
405 $l->sort;
406 $l->get_vadjustment->set_value($pos);
407 $l->thaw;
408
409 delete $self->{event_update};
410 0;
411 });
412}
413
414sub event_update_games {
415 my ($self) = @_;
416
417 $self->{event_update_games} ||= Gtk->timeout_add(200, sub {
418 my $l = $self->{gamelist};
419
420 $l->freeze;
421 my $pos = $l->get_vadjustment->get_value;
422 $l->clear;
423
424 my $row = 0;
425 for (values %{$self->{games}}) {
426 $l->append($_->type, $_->user0, $_->user1, $_->rules, $_->notes);
427 $l->set_row_data($row++, $_);
428 }
429 $l->sort;
430 $l->get_vadjustment->set_value($pos);
431 $l->thaw;
432
433 delete $self->{event_update_games};
434 0;
435 });
436}
437
438sub join {
439 my ($self) = @_;
440 $self->SUPER::join;
441
442 $self->{window}->show_all;
443}
444
445sub part {
446 my ($self) = @_;
447 $self->SUPER::part;
448
449 delete $::config->{rooms}{$self->{channel}};
450 $self->{window}->hide_all;
451 $self->event_update;
452 $self->event_update_games;
453}
454
455sub event_join {
456 my ($self) = @_;
457 $self->SUPER::event_join;
458
459 $::config->{rooms}{$self->{channel}} = 1;
460}
461
462sub event_update_roominfo {
463 my ($self) = @_;
464
465 $self->{text}->insert(undef, undef, undef, "\n$self->{owner}: $self->{description}\n");
466}
467
468sub inject_msg_room {
469 my ($self, $msg) = @_;
470 return unless $self->{channel} == $msg->{channel};
471
472 $self->{text}->insert(undef, undef, undef, "\n$msg->{name}: $msg->{message}");
473}
474
475#############################################################################
476
477package game;
478
479use KGS::Constants;
480
481use base KGS::Listener::Game;
482use base KGS::Game;
483
484sub new {
485 my $self = shift;
486 $self = $self->SUPER::new(@_);
487
488 $self->listen($self->{conn});
489
490 $self->{window} = new Gtk::Window 'toplevel';
491 $self->{window}->set_title("KGS Game ".$self->user0." ".$self->user1);
492 ::state $self->{window}, "game::window", undef, window_size => [600, 500];
493
494 $self->{window}->signal_connect(delete_event => sub { $self->part; 1 });
495
496 $self->{window}->add(my $hpane = new Gtk::HPaned);
497 ::state $hpane, "game::hpane", undef, hpane_position => 500;
498
499 $::config{aa} = 1;
500 $self->{canvas} = $::config{aa} ? new_aa Gnome::Canvas : new Gnome::Canvas;
501 $hpane->add($self->{canvas});
502
503 {
504 my $line_colour = $::config{line_colour} || "darkbrown";
505 my $border = 0.1;
506 my $ofs = 0.5 / $self->{size};
507
508 $self->{canvas}->set_pixels_per_unit(1000);
509 $self->{canvas}->set_scroll_region(-$border,-$border,1+$border,1+$border);
510
511 $self->{canvas}->signal_connect(size_allocate => sub {
512 my ($w, $h) = @{$_[1]}[2,3];
513
514 $self->{canvas}->set_pixels_per_unit(($w > $h ? $h : $w)/(1+$border*2));
515
516 1;
517 });
518
519 my $croot = $self->{canvas}->root;
520 my $cgroup = $croot; #->new($croot, "Gnome::CanvasGroup");
521
522 if ($::board_img) {
523 $cgroup->new($cgroup, "Gnome::CanvasImage",
524 x => -$border, y => -$border,
525 width => 1+$border*2, height => 1+$border*2,
526 image => $::board_img,
527 anchor => "nw"
528 );
529 } else {
530 $cgroup->new($cgroup, "Gnome::CanvasRect",
531 x1 => -$border, x2 => 1+$border,
532 y1 => -$border, y2 => 1+$border,
533 outline_color => "black",
534 fill_color => "brown",
535 width_pixels => 2,
536 );
537 }
538
539 my $a = "A";
540 for my $i (1 .. $self->{size}) { # one more iteration for the last lines
541 my $k = $i / $self->{size} - $ofs;
542
543 $cgroup->new($cgroup, "Gnome::CanvasLine",
544 points => [ $k,$ofs, $k,1-$ofs ],
545 fill_color => $line_colour,
546 width_pixels => 1);
547
548 $cgroup->new($cgroup, "Gnome::CanvasLine",
549 points => [ $ofs,$k, 1-$ofs,$k ],
550 fill_color => $line_colour,
551 width_pixels => 1);
552
553 for ( [$k,-$border*0.5,$a], [$k,1+$border*0.5,$a], [-$border*0.5,$k,$i], [1+$border*0.5,$k,$i] ) {
554 my ($x, $y, $text) = @$_;
555
556 my $text = $cgroup->new($cgroup, "Gnome::CanvasText",
557 x => 0, y => 0, text => $text,
558 justification => "center",
559 anchor => "center",
560 font => $::config{aa} ? "-*-helvetica-medium-r-*--34-*" : "-*-helvetica-bold-r-*--17-*",
561 fill_color => $line_colour);
562
563 $text->affine_relative($border*0.015,0, 0,$border*0.015, $x,$y);
564 }
565
566 $a++;
567 }
568
569 my $stones = [[]];
570
571 for my $x (1 .. $self->{size}) {
572 my $xk = $x / $self->{size} - $ofs;
573 for my $y (1 .. $self->{size}) {
574 my $yk = $y / $self->{size} - $ofs;
575
576 my $col = $stones->[$x-1][$y-1] = [];
577
578 if (1) {
579 $col->[0] =
580 $cgroup->new($cgroup, "Gnome::CanvasImage",
581 x => $xk, y => $yk,
582 width => $ofs*2, height => $ofs*2,
583 image => $::black_img[int rand @::black_img],
584 anchor => "center");
585 $col->[1] =
586 $cgroup->new($cgroup, "Gnome::CanvasImage",
587 x => $xk, y => $yk,
588 width => $ofs*2, height => $ofs*2,
589 image => $::white_img[int rand @::white_img],
590 anchor => "center");
591 } else {
592 die "need pixmaps\n";
593 # too large, scale has NO effect
594 $col->[0] =
595 $cgroup->new($cgroup, "Gnome::CanvasEllipse",
596 x1 => $xk, x2 => $xk + 0.001,
597 y1 => $yk, y2 => $yk + 0.001,
598 outline_color => "black", width_pixels => 2,
599 fill_color => "black");
600 $col->[1] =
601 $cgroup->new($cgroup, "Gnome::CanvasEllipse",
602 x1 => $xk, x2 => $xk + 0.001,
603 y1 => $yk, y2 => $yk + 0.001,
604 outline_color => "black", width_pixels => 2,
605 fill_color => "white");
606 }
607 }
608 }
609
610 $self->{board_gfx}{stones} = $stones;
611 }
612
613 $hpane->add(my $vpane = new Gtk::VPaned);
614 ::state $vpane, "game", $self->{name}, vpane_position => 80;
615
616 $vpane->add(my $sw = new Gtk::ScrolledWindow);
617 $sw->set_policy("automatic", "always");
618
619 $sw->add($self->{userlist} = new_with_titles Gtk::CList "User", "Rank", "Flags");
620 ::clist_autosort $self->{userlist};
621 ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];
622
623 $vpane->add(my $vbox = new Gtk::VBox);
624
625 $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
626 $sw->set_policy("automatic", "always");
627
628 $sw->add($self->{text} = new Gtk::Text);
629
630 $vbox->pack_start(($self->{entry} = new Gtk::Entry), 0, 1, 0);
631 $self->{entry}->signal_connect(activate => sub {
632 my $text = $self->{entry}->get_text;
633 # add message
634 $self->{entry}->set_text("");
635 });
636
637 $self;
638}
639
640sub event_update {
641 my ($self) = @_;
642
643 $self->{event_update} ||= Gtk->timeout_add(200, sub {
644 my $l = $self->{userlist};
645
646 $l->freeze;
647 my $pos = $l->get_vadjustment->get_value;
648 $l->clear;
649
650 my $row = 0;
651 for (values %{$self->{users}}) {
652 $l->append($_->{name});
653 $l->set_row_data($row++, $_);
654 }
655 $l->sort;
656 $l->get_vadjustment->set_value($pos);
657 $l->thaw;
658
659 delete $self->{event_update};
660 0;
661 });
662}
663
664sub join {
665 my ($self) = @_;
666 $self->SUPER::join;
667
668 $self->{window}->show_all;
669}
670
671sub part {
672 my ($self) = @_;
673 $self->SUPER::part;
674
675 $self->{window}->hide_all;
676 $self->event_update;
677}
678
679sub event_update_tree {
680 my ($self) = @_;
681
682 my $board = new KGS::Game::Board $self->{size};
683 $board->interpret_path ($self->get_path);
684
685# if (not defined $self->{board_pm}) {
686# $self->{board_pm} = new Gtk::Gdk::Pixmap ($self->{board}->window, 100, 100, -1);
687# $self->{board_pm}->draw_rectangle($self->{board}->style->white_gc, 1, 0, 0, 100, 100);
688# }
689# my $red = $self->{board}->window->get_colormap->color_alloc( { red => 65000, green => 0, blue => 0 } );
690# my $red_gc = new Gtk::Gdk::GC ( $self->{board}->window );
691# $red_gc->set_foreground( $red );
692#
693# my $px = $self->{board_pm};
694
695 for my $x (0 .. $self->{size} - 1) {
696 for my $y (0 .. $self->{size} - 1) {
697 my $v = $board->{board}[$x][$y];
698
699 $v & MARK_B
700 ? $self->{board_gfx}->{stones}->[$x][$y][0]->show
701 : $self->{board_gfx}->{stones}->[$x][$y][0]->hide;
702 $v & MARK_W
703 ? $self->{board_gfx}->{stones}->[$x][$y][1]->show
704 : $self->{board_gfx}->{stones}->[$x][$y][1]->hide;
705 }
706 }
707}
708 121
7091; 1221;
710 123
711 124
712

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines