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

Comparing kgsueme/bin/kgsueme (file contents):
Revision 1.27 by pcg, Sat May 31 03:47:26 2003 UTC vs.
Revision 1.63 by root, Wed Jun 2 04:39:07 2004 UTC

1#!/usr/bin/perl 1#!/usr/bin/perl
2 2
3use Glib;
3use Gtk; 4use Gtk2;
4use Gtk::Gdk;
5use Gtk::Gdk::Pixbuf;
6#use Gtk::Gdk::ImlibImage;
7 5
8use KGS::Protocol; 6use KGS::Protocol;
9use KGS::Listener::Debug; 7use KGS::Listener::Debug;
10 8
11use Audio::Data; 9use Audio::Data;
… …
13 11
14use IO::Socket::INET; 12use IO::Socket::INET;
15use List::Util; 13use List::Util;
16use Errno; 14use Errno;
17 15
16use Storable;
17use Carp;
18
18init Gtk; 19init Gtk2;
20
21$SIG{QUIT} = sub { Carp::confess "SIGQUIT" };
19 22
20our $HACK = 1; # do NEVER enable. ;) 23our $HACK = 1; # do NEVER enable. ;)
21our $DEBUG_EXPOSE = 1; 24our $DEBUG_EXPOSE = 0;
22 25
23if ($HACK) { 26if ($HACK) {
24 $KGS::debug = 1; 27 $KGS::debug = 1;
25} 28}
26 29
30BEGIN {
27our $VERSION = "0.1"; 31 our $VERSION = "0.1";
28 32
29our $config; 33 our $config;
30our $LIBDIR = "."; 34 our $LIBDIR = ".";
31our $IMGDIR = "$LIBDIR/images";
32our $SNDDIR = "$LIBDIR/sounds";
33 35
34sub load_img { 36 use KGS::Constants;
35 new_from_file Gtk::Gdk::Pixbuf "$IMGDIR/$_[0]"
36# load_image Gtk::Gdk::ImlibImage "$IMGDIR/$_[0]"
37 or die "$IMGDIR/$_[0]: $!";
38}
39 37
40my @fontchars = ('A' .. 'Z', 0 .. 9); 38 for (qw(util.pl gtk.pl chat.pl sound.pl user.pl gamelist.pl userlist.pl
41 39 game.pl room.pl roomlist.pl app.pl)) {
42our @black_img = load_img "b-01.png"; 40 require (KGS::Constants::findfile "KGS/kgsueme/$_");
43our @white_img = map +(load_img "w-0$_.png"), 1,2,3,4,5; 41 die if $@;
44our @triangle_img = map +(load_img "triangle-$_.png"), qw(b w);
45our @square_img = map +(load_img "square-$_.png"), qw(b w);
46our @circle_img = map +(load_img "circle-$_.png"), qw(b w);
47our $board_img = load_img "woodgrain-01.jpg";
48
49our @font = (
50 [map +(load_img "font/$_-black.png"), @fontchars],
51 [map +(load_img "font/$_-white.png"), @fontchars],
52 );
53our %fontmap;
54@fontmap{@fontchars} = (0..25 + 10);
55@fontmap{'a' .. 'z'} = (0..25);
56
57{
58 #my $audioserver = new Audio::Play(0);
59 my %sound;
60 $SIG{CHLD} = 'IGNORE';
61
62 for (qw(alarm warning move)) {
63 local $/;
64 open my $snd, "<", "$SNDDIR/$_"
65 or die "$SNDDIR: $!";
66 binmode $snd;
67
68 $sound{$_} = new Audio::Data;
69 $sound{$_}->Load($snd);
70 }
71
72 sub play_sound {
73 if (fork == 0) {
74 if (my $audioserver = new Audio::Play(1)) {
75 $audioserver->play ($sound{$_[0]});
76 }
77 Gtk->_exit(0);
78 }
79 } 42 }
80} 43}
81 44
82{ 45if ($ENV{KGSUEME_DEBUG}) {
83 use Storable ();
84 use Scalar::Util ();
85
86 my $staterc = "$ENV{HOME}/.kgsueme";
87
88 my $state = -r $staterc ? Storable::retrieve($staterc) : {};
89 my @widgets;
90
91 $config = $state->{config} ||= {};
92
93 $config{speed} = 0;#d# optimize for speed or memory?
94 $config{conserve_memory} = 0;
95
96 # grr... more gtk+ brokenness
97 my %get = (
98 hpane_position => sub { ($_[0]->children)[0]->allocation->[2] },
99 vpane_position => sub { ($_[0]->children)[0]->allocation->[3] },
100 window_size => sub { [ @{$_[0]->allocation}[2,3] ] },
101 #window_pos => sub { die KGS::Listener::Debug::dumpval [ $_[0]->get_root_origin ] },
102 clist_column_widths => sub {
103 $_[0]{column_widths};
104 },
105 );
106
107 my %set = (
108 hpane_position => sub { $_[0]->set_position($_[1]) },
109 vpane_position => sub { $_[0]->set_position($_[1]) },
110 window_size => sub { $_[0]->set_default_size(@{$_[1]}) },
111 #window_pos => sub { $_[0]->set_uposition(@{$_[1]}) if @{$_[1]} },
112 clist_column_widths => sub {
113 my ($w, $v) = @_;
114 $v->[$_] && $w->set_column_width($_, $v->[$_]) for 0..$#$v;
115 $w->{column_widths} = $v;
116 $w->signal_connect(resize_column => sub { $v->[$_[1]] = $_[2]; });
117 },
118 );
119
120 sub state {
121 my ($widget, $class, $instance, %attr) = @_;
122
123 while (my ($k, $v) = each %attr) {
124 my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
125 $v = $state->{$class}{"*"}{$get} if exists $state->{$class}{"*"}{$get};
126 $v = $state->{$class}{$instance}{$get} if exists $state->{$class}{$instance}{$get};
127 $set{$get} ? $set{$get}->($widget, $v) : $widget->set($set => $v);
128 }
129
130 $widget = [$widget, $class, $instance, \%attr];
131 Scalar::Util::weaken $widget->[0];
132
133 @widgets = (grep $_->[0], @widgets, $widget);
134 }
135
136 sub save_state {
137 for (@widgets) {
138 if ($_->[0]) {
139 my ($widget, $class, $instance, $attr) = @$_;
140
141 $widget->realize;
142
143 while (my ($k, $v) = each %$attr) {
144 my ($set, $get) = $k =~ /=/ ? split /=/, $k : ($k, $k);
145 $v = $get{$get} ? $get{$get}->($widget) : $widget->get($get);
146
147 $state->{$class}{"*"}{$get} = $v;
148 $state->{$class}{$instance}{$get} = $v;
149 }
150 }
151 ::status("save_state", "layout saved");
152 }
153
154 Storable::nstore($state, $staterc);
155 }
156}
157
158# make a clist unselectable
159sub clist_autosort {
160 my $w = shift;
161 my ($c, $o) = (-1);
162 for (0..$w->columns-1) {
163 $w->signal_connect(click_column => sub {
164 if ($_[1] != $c) {
165 $c = $_[1];
166 $o = 0;
167 } else {
168 $o = !$o;
169 }
170 $w->set_sort_column($c);
171 $w->set_sort_type($o ? "descending" : "ascending");
172 $w->sort;
173 });
174 }
175
176}
177
178{
179 my $main = new kgsueme;
180
181 my %context_id;
182
183 sub status {
184 my ($type, $text) = @_;
185
186 $main->{status}->pop($context_id{$type}) if $context_id{$type};
187 $main->{status}->push($context_id{$type} ||= $main->{status}->get_context_id($type), $text) if $text;
188 }
189}
190
191if (0) {
192 use KGS::Constants; 46 use KGS::Constants;
193 47
194 for (19) { 48 for (19) {
195 my $board = new game %{Storable::retrieve "testboard.storable"}; 49 my $game = new game size => $_;
50
51 $game->event_challenge (
52bless( {
53 type => 0,
54 black => bless( {
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 white => 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;
79 }
80 $game->event_update_tree;
81 }
196 82
197 if (0) { 83 if (0) {
198 $board->{board} = new KGS::Game::Board; 84 $game->{cur_board} = new KGS::Game::Board;
199 $board->{board}{board}[0][0] = MARK_B; 85 my @x = (
200 $board->{board}{board}[1][1] = MARK_GRAY_B | MARK_SMALL_W;
201 $board->{board}{board}[2][2] = MARK_W | MARK_TRIANGLE;
202 $board->{board}{board}[1][2] = MARK_B | MARK_LABEL;
203 $board->{board}{label}[1][2] = "198";
204 $board->{board}{board}[0][2] = MARK_W | MARK_LABEL;
205 $board->{board}{label}[0][2] = "AWA";
206 }
207 $board->{window}->show_all;
208 }
209}
210
211main Gtk;
212
213#############################################################################
214
215package kgsueme;
216
217use base KGS::Listener;
218
219sub new {
220 my $self = shift;
221 $self = $self->SUPER::new(@_);
222
223 $self->{conn} = new KGS::Protocol;
224
225 KGS::Listener::Debug->new->listen($self->{conn}); #d# debug only :)
226
227 $self->listen($self->{conn}, "login");
228
229 $self->{roomlist} = new roomlist conn => $self->{conn};
230
231 $self->{window} = new Gtk::Window 'toplevel';
232 $self->{window}->set_title('kgsueme');
233 ::state $self->{window}, "main::window", undef, window_size => [400, 100];
234 $self->{window}->signal_connect(delete_event => sub { main_quit Gtk; 1 });
235
236 $self->{window}->add(my $vbox = new Gtk::VBox);
237
238 $vbox->pack_start(($buttonbox = new Gtk::HButtonBox), 0, 1, 0);
239 $buttonbox->set_spacing(0);
240
241 my $button = sub {
242 $buttonbox->add(my $button = new Gtk::Button $_[0]);
243 signal_connect $button clicked => $_[1];
244 };
245
246 $button->("Login", sub { $self->login; });
247 $button->("Roomlist", sub { $self->{roomlist}->show; });
248 $button->("Save Config & Layout", sub { ::save_state });
249 $button->("Quit", sub { main_quit Gtk });
250
251 $vbox->pack_start((my $hbox = new Gtk::HBox), 0, 1, 0);
252
253 $hbox->add(new Gtk::Label "Login");
254
255 $hbox->add($self->{login} = new_with_max_length Gtk::Entry 12);
256 $self->{login}->set_text($::config->{login});
257
258 if ($::HACK) {
259 $self->{login}->signal_connect(activate => sub {
260 $self->{conn}{name} = $self->{login}->get_text;
261 });
262 }
263
264 $hbox->add(new Gtk::Label "Password");
265 $hbox->add($self->{password} = new Gtk::Entry);
266 $self->{password}->set_visibility(0);
267
268 $vbox->pack_start(($self->{status} = new Gtk::Statusbar), 0, 1, 0);
269
270 $self->{window}->show_all;
271
272 $self;
273}
274
275sub login {
276 my ($self) = @_;
277
278 $self->{conn}->disconnect;
279
280 # initialize new socket and connection
281 my $sock = new IO::Socket::INET PeerHost => "kgs.kiseido.com", PeerPort => "2379"
282 or die;
283
284 $sock->blocking(1);
285 $self->{conn}->handshake($sock);
286 $sock->blocking(0);
287
288 my $input; $input = input_add Gtk::Gdk fileno $sock, "read", sub {
289 # this is dorked
290 my $buf;
291 if (0 >= sysread $sock, $buf, 16384
292 and !$!{EINTR} and !$!{EAGAIN}) {
293 input_remove Gtk::Gdk $input;
294 $self->event_disconnect;
295 }
296 $self->{conn}->feed_data($buf);
297 };
298
299 # now login
300 $self->{conn}->login("kgsueme $VERSION $^O", $self->{login}->get_text, $self->{password}->get_text);
301}
302
303sub inject_login {
304 my ($self, $msg) = @_;
305
306 ::status("login", "logged in as '$self->{conn}{name}' with status '$msg->{result}'");
307 $::config->{login} = $self->{conn}{name};
308
309 if ($msg->{success}) {
310 for (keys %{$::config->{rooms}}) {
311 $self->{roomlist}->join_room($_);
312 }
313 }
314}
315
316sub event_disconnect { }
317
318#############################################################################
319
320package roomlist;
321
322use base KGS::Listener::Roomlist;
323
324sub new {
325 my $self = shift;
326 $self = $self->SUPER::new(@_);
327
328 $self->listen($self->{conn});
329
330 $self->{window} = new Gtk::Window 'toplevel';
331 $self->{window}->set_title('KGS Rooms');
332 ::state $self->{window}, "roomlist::window", undef, window_size => [400, 200];
333
334 $self->{window}->signal_connect(delete_event => sub { $self->{window}->hide; 1 });
335
336 $self->{window}->add(my $vbox = new Gtk::VBox);
337
338 $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
339 $sw->set_policy("automatic", "always");
340
341 $sw->add($self->{roomlist} = new_with_titles Gtk::CList "Group", "Room Name", "Users", "Games", "Flags", "Channel");
342 $self->{roomlist}->set_selection_mode('multiple');
343 ::clist_autosort $self->{roomlist};
344 ::state $self->{roomlist}, "roomlist::roomlist", undef, clist_column_widths => [20, 200];
345
346 $self->{roomlist}->signal_connect(select_row => sub {
347 my $room = $self->{roomlist}->get_row_data($_[1])
348 or return;
349 $self->{roomlist}->unselect_all;
350 $self->join_room($room->{channel});
351 });
352
353 $self;
354}
355
356sub join_room {
357 my ($self, $channel) = @_;
358
359 $self->{room}{$channel} ||= room->new(channel => $channel, conn => $self->{conn}, users => {});
360 $self->{room}{$channel}->join;
361}
362
363sub show {
364 my ($self, $msg) = @_;
365
366 $self->msg(list_rooms => group => $_) for 0..5; # fetch all room names (should not!)
367 $self->{window}->show_all;
368}
369
370sub event_update_rooms {
371 my ($self) = @_;
372
373 $self->{event_update} ||= Gtk->timeout_add(200, sub {
374 my $l = $self->{roomlist};
375
376 $l->freeze;
377 my $pos = $l->get_vadjustment->get_value;
378 $l->clear;
379
380 my $row = 0;
381 for (values %{$self->{rooms}}) {
382 $l->append($_->{group}, $_->{name}, $_->{users}, $_->{games}, $_->{flags}, $_->{channel});
383 $l->set_row_data($row++, $_);
384 }
385 $l->sort;
386 $l->get_vadjustment->set_value($pos);
387 $l->thaw;
388
389 delete $self->{event_update};
390 0;
391 });
392}
393
394#############################################################################
395
396package room;
397
398use base KGS::Listener::Room;
399
400sub new {
401 my $self = shift;
402 $self = $self->SUPER::new(@_);
403
404 $self->listen($self->{conn}, qw(msg_room:));
405
406 $self->{window} = new Gtk::Window 'toplevel';
407 $self->{window}->set_title("KGS Room $self->{name}");
408 ::state $self->{window}, "room::window", $self->{name}, window_size => [600, 400];
409
410 $self->{window}->signal_connect(delete_event => sub { $self->part; 1 });
411
412 $self->{window}->add(my $hpane = new Gtk::HPaned);
413 ::state $hpane, "room::hpane", $self->{name}, hpane_position => 200;
414
415 $hpane->add(my $vpane = new Gtk::VPaned);
416 ::state $vpane, "room::vpane", $self->{name}, vpane_position => 200;
417
418 $vpane->add(my $sw = new Gtk::ScrolledWindow);
419 $sw->set_policy("automatic", "always");
420
421 $sw->add($self->{gamelist} = new_with_titles Gtk::CList "T", "Black", "White", "Rules", "Notes");
422 ::clist_autosort $self->{gamelist};
423 ::state $self->{gamelist}, "room::gamelist", $self->{name}, clist_column_widths => [20, 120, 120, 120];
424
425 $self->{gamelist}->signal_connect(select_row => sub {
426 my $game = $self->{gamelist}->get_row_data($_[1])
427 or return;
428 $self->{game}{$game->{channel}} ||= new game %$game, conn => $self->{conn}, room => $self;
429 $self->{game}{$game->{channel}}->join;
430 $self->{gamelist}->unselect_all;
431 });
432
433 $vpane->add(my $vbox = new Gtk::VBox);
434
435 $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
436 $sw->set_policy("automatic", "always");
437
438 $sw->add($self->{text} = new Gtk::Text);
439
440 $vbox->pack_start(($self->{entry} = new Gtk::Entry), 0, 1, 0);
441 $self->{entry}->signal_connect(activate => sub {
442 my $text = $self->{entry}->get_text;
443 $self->say($text) if $text =~ /\S/;
444 $self->{entry}->set_text("");
445 });
446
447 $hpane->add(my $sw = new Gtk::ScrolledWindow);
448 $sw->set_policy("automatic", "always");
449
450 $sw->add($self->{userlist} = new_with_titles Gtk::CList "User", "Rank", "Flags");
451 ::clist_autosort $self->{userlist};
452 ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];
453
454 $self;
455}
456
457sub join {
458 my ($self) = @_;
459 $self->SUPER::join;
460
461 $self->{window}->show_all;
462}
463
464sub part {
465 my ($self) = @_;
466 $self->SUPER::part;
467
468 delete $::config->{rooms}{$self->{channel}};
469 $self->{window}->hide_all;
470}
471
472sub inject_msg_room {
473 my ($self, $msg) = @_;
474
475 $self->{text}->insert(undef, undef, undef, "\n$msg->{name}: $msg->{message}");
476}
477
478sub event_update_users {
479 my ($self) = @_;
480
481 $self->{event_update} ||= Gtk->timeout_add(200, sub {
482 my $l = $self->{userlist};
483
484 $l->freeze;
485 my $pos = $l->get_vadjustment->get_value;
486 $l->clear;
487
488 my $row = 0;
489 for (values %{$self->{users}}) {
490 $l->append($_->{name});
491 $l->set_row_data($row++, $_);
492 }
493 $l->sort;
494 $l->get_vadjustment->set_value($pos);
495 $l->thaw;
496
497 delete $self->{event_update};
498 0;
499 });
500}
501
502sub event_update_games {
503 my ($self) = @_;
504
505 $self->{event_update_games} ||= Gtk->timeout_add(200, sub {
506 my $l = $self->{gamelist};
507
508 $l->freeze;
509 my $pos = $l->get_vadjustment->get_value;
510 $l->clear;
511
512 my $row = 0;
513 for (values %{$self->{games}}) {
514 $l->append($_->type, $_->user0, $_->user1, $_->rules, $_->notes);
515 $l->set_row_data($row++, $_);
516 }
517 $l->sort;
518 $l->get_vadjustment->set_value($pos);
519 $l->thaw;
520
521 delete $self->{event_update_games};
522 0;
523 });
524}
525
526sub event_join {
527 my ($self) = @_;
528 $self->SUPER::event_join;
529
530 $::config->{rooms}{$self->{channel}} = 1;
531}
532
533sub event_update_roominfo {
534 my ($self) = @_;
535
536 $self->{text}->insert(undef, undef, undef, "\n$self->{owner}: $self->{description}\n");
537}
538
539#############################################################################
540
541package game;
542
543use KGS::Constants;
544use KGS::Game::Board;
545
546use base KGS::Listener::Game;
547use base KGS::Game;
548
549sub new {
550 my $self = shift;
551 $self = $self->SUPER::new(@_);
552
553 $self->listen($self->{conn});
554
555 $self->{window} = new Gtk::Window 'toplevel';
556 my $title = $self->{channel} ? $self->user0." ".$self->user1 : "Game Window";
557 $self->{window}->set_title("KGS Game $title");
558 ::state $self->{window}, "game::window", undef, window_size => [600, 500];
559
560 $self->{window}->signal_connect(delete_event => sub { $self->part; 1 });
561
562 $self->{window}->add(my $hpane = new Gtk::HPaned);
563 ::state $hpane, "game::hpane", undef, hpane_position => 500;
564
565 $hpane->pack1(my $vbox = new Gtk::VBox);
566
567 $vbox->pack_start((my $frame = new Gtk::Frame), 0, 1, 0);
568
569 {
570 $frame->add(my $vbox = new Gtk::VBox);
571 $vbox->add($self->{title} = new Gtk::Label $title);
572
573 $self->{moveadj} = new Gtk::Adjustment 0, 0, 0, 1, 10, 0;
574 $vbox->add(my $scale = new Gtk::HScale $self->{moveadj});
575 $scale->set_draw_value (1);
576 $scale->set_digits (0);
577 $scale->set_value_pos('top');
578
579 $self->{moveadj}->signal_connect (value_changed => sub {
580 $self->{board} = new KGS::Game::Board $self->{size};
581 $self->{board}->interpret_path ([@{$self->{path}}[0 .. $self->{moveadj}->value - 1]]);
582
583 my $area = $self->repaint_board;
584
585 # force a redraw (not perfect(?))
586 $self->expose ($area);
587
588 $self->{text}->backward_delete($self->{text}->get_length);
589 $self->{text}->insert(undef, undef, undef, KGS::Listener::Debug::dumpval([$self->{board}{time},$self->{board}{captures}]). $self->{board}{comment});
590 });
591
592 $self->{moveadj}->upper (scalar @{$self->{path}}) if $self->{path};
593 }
594
595 Gtk::Widget->push_visual (Gtk::Gdk::Rgb->get_visual);
596 Gtk::Widget->push_colormap (Gtk::Gdk::Rgb->get_cmap);
597 $vbox->pack_start(($self->{canvas} = new Gtk::DrawingArea), 1, 1, 0);
598 Gtk::Widget->pop_colormap;
599 Gtk::Widget->pop_visual;
600
601 $self->{canvas}->signal_connect(configure_event => \&configure_event, $self);
602 $self->{canvas}->signal_connect(expose_event => \&expose_event, $self);
603
604 $hpane->pack2((my $vpane = new Gtk::VPaned), 0, 0);
605 ::state $vpane, "game", $self->{name}, vpane_position => 80;
606
607 $vpane->add(my $sw = new Gtk::ScrolledWindow);
608 $sw->set_policy("automatic", "always");
609
610 $sw->add($self->{userlist} = new_with_titles Gtk::CList "User", "Rank", "Flags");
611 ::clist_autosort $self->{userlist};
612 ::state $self->{userlist}, "room::userlist", $self->{name}, clist_column_widths => [120, 30];
613
614 $vpane->add(my $vbox = new Gtk::VBox);
615
616 $vbox->pack_start((my $sw = new Gtk::ScrolledWindow), 1, 1, 0);
617 $sw->set_policy("automatic", "always");
618
619 $sw->add($self->{text} = new Gtk::Text);
620
621 $vbox->pack_start(($self->{entry} = new Gtk::Entry), 0, 1, 0);
622 $self->{entry}->signal_connect(activate => sub {
623 my $text = $self->{entry}->get_text;
624 # add message
625 $self->{entry}->set_text("");
626 });
627
628 $self;
629}
630
631sub event_update_users {
632 my ($self) = @_;
633
634 room::event_update_users $self;
635}
636
637sub join {
638 my ($self) = @_;
639 $self->SUPER::join;
640
641 $self->{window}->show_all;
642}
643
644sub part {
645 my ($self) = @_;
646 $self->SUPER::part;
647
648 $self->{window}->hide;
649}
650
651sub configure_event {
652 my ($widget, $self, $event) = @_;
653 delete $self->{stack};
654 delete $self->{pixbuf};
655 delete $self->{board_shown};
656 delete $self->{background};
657 $self->repaint_board;
658 1;
659}
660
661sub INTERP_NEAREST (){ 1 }
662sub INTERP_TILES (){ 1 }
663sub INTERP_BILINEAR (){ 2 }
664sub INTERP_HYPER (){ 3 }
665
666sub new_pixbuf {
667 my ($w, $h, $alpha, $clear) = @_;
668
669 my $pixbuf = new Gtk::Gdk::Pixbuf 'rgb', $alpha, 8, $w, $h;
670
671 if ($clear) { # damn, need to clear it ourselves
672 my $row = "\x00\x00\x00\x00" x $w;
673 $pixbuf->put_pixels ($row, $_, 0) for 0 .. $h - 1;
674 }
675
676 $pixbuf;
677}
678
679sub scale_pixbuf {
680 my ($src, $w, $h, $mode) = @_;
681
682 my $dst = new_pixbuf $w, $h, 1;
683
684 $src->scale(
685 $dst, 0, 0, $w, $h, 0, 0,
686 $w / $src->get_width, $h / $src->get_height,
687 $mode,
688 );
689
690 $dst;
691}
692
693# create a stack of stones
694sub create_stack {
695 my ($self, $mark, $size, $rand) = @_;
696
697 my $shadow = $size * 0.05;
698
699 my $c = \$self->{stack}{$mark};
700 unless ($$c) {
701 for my $stone ($mark & (MARK_W | MARK_GRAY_W) ? @::white_img : @::black_img) {
702 my $base = new_pixbuf $size + $shadow, $size + $shadow, 1, 1;
703
704 # zeroeth the shadow
705 if ($mark & (MARK_B | MARK_W)) {
706 $::black_img[0]->composite (
707 $base, $shadow, $shadow, $size, $size, $shadow-0.5, $shadow-0.5,
708 $size / $stone->get_width, $size / $stone->get_height,
709 $::config{speed} ? INTERP_NEAREST : INTERP_TILES, 128
710 );
711 }
712
713 # first the big stones
714 for ([MARK_B, 255],
715 [MARK_W, 255],
716 [MARK_GRAY_B, 128], 86 #MARK_B,
717 [MARK_GRAY_W, 128]) { 87 #MARK_W,
718 my ($mask, $alpha) = @$_; 88 #MARK_GRAY_B | MARK_SMALL_W,
719 if ($mark & $mask) { 89 #MARK_GRAY_W | MARK_SMALL_B,
720 $stone->composite ( 90 #MARK_W | MARK_TRIANGLE,
721 $base, 0, 0, $size, $size, -0.5, -0.5, 91 0, 0, 0,
722 $size / $stone->get_width, $size / $stone->get_height,
723 $::config{speed} ? INTERP_NEAREST : INTERP_HYPER, $alpha
724 ); 92 );
93 for $x (0..18) {
94 for $y (0..18) {
95 $game->{cur_board}{board}[$x][$y] =
96 $x[rand @x];
725 } 97 }
726 } 98 }
727 99
728 # then the samll stones 100 $game->{cur_board}{board}[0][0] = MARK_B;
729 for ([MARK_SMALL_B, $::black_img[$rand % @::black_img]], 101 $game->{cur_board}{board}[1][1] = MARK_GRAY_B | MARK_SMALL_W;
730 [MARK_SMALL_W, $::white_img[$rand % @::white_img]]) { 102 $game->{cur_board}{board}[2][2] = MARK_W | MARK_TRIANGLE;
731 my ($mask, $img) = @$_; 103 $game->{cur_board}{board}[1][2] = MARK_B | MARK_LABEL;
732 if ($mark & $mask) { 104 $game->{cur_board}{label}[1][2] = "198";
733 $img->composite ( 105 $game->{cur_board}{board}[0][2] = MARK_W | MARK_LABEL;
734 $base, ($size / 4) x2, (int ($size / 2 + 0.5)) x2, ($size / 4 - 0.5) x 2, 106 $game->{cur_board}{label}[0][2] = "AWA";
735 $size / $img->get_width / 2, $size / $img->get_height / 2, 107 $game->{board}->set_board ($game->{cur_board});
736 $::config{speed} ? INTERP_NEAREST : INTERP_HYPER, 192
737 );
738 }
739 }
740
741 # and lastly any markers
742 my $dark_bg = ! ! ($mark & (MARK_B | MARK_GRAY_B));
743
744 for ([MARK_CIRCLE, $::circle_img[$dark_bg]],
745 [MARK_TRIANGLE, $::triangle_img[$dark_bg]],
746 [MARK_SQUARE, $::square_img[$dark_bg]]) {
747 my ($mask, $img) = @$_;
748 if ($mark & $mask) {
749 $img->composite (
750 $base, 0, 0, $size, $size, -0.5, -0.5,
751 $size / $img->get_width, $size / $img->get_height,
752 $::config{speed} ? INTERP_NEAREST : INTERP_HYPER, 255
753 );
754 }
755 }
756
757 push @$$c, $base;
758 } 108 }
759 } 109 }
110 main Gtk2;
760 111
761 $$c->[$rand % @$$c];
762} 112}
763 113
764sub pixbuf_text { 114our $app = new app;
765 my ($pixbuf, $colour, $x, $y, $height, $text) = @_;
766 115
767 my @c = grep $_, 116main Gtk2;
768 map $::font[$colour][$::fontmap{$_}],
769 split //, $text;
770 117
771 if (@c) { 118$app->destroy;
772 my $spacing = $height * 0.1;
773 my $s = $height / List::Util::max map $_->get_height, @c;
774 my $W = List::Util::sum map $_->get_width, @c;
775 119
776 $x -= ($W * $s + $spacing * (@c - 1)) * 0.5; 120Gtk2->main_iteration while Gtk2->events_pending;
777 $y -= $height * 0.5;
778
779 for (@c) {
780 my $w = $_->get_width * $s;
781 $_->composite ($pixbuf,
782 $x, $y, $w+0.999, $height+0.999, $x, $y, $s, $s,
783 $::config{speed} ? INTERP_NEAREST : INTERP_BILINEAR, 255);
784
785 $x += $w + $spacing;
786 }
787 }
788}
789
790my $black_pb;
791
792sub pixbuf_rect {
793 my ($pb, $x1, $y1, $x2, $y2) = @_;
794 # we fake lines by... an unspeakable method :/
795 unless ($black_pb) {
796 $black_pb = new_pixbuf 1, 1, 0, 0;
797 $black_pb->put_pixels ("\x44\x11\x11", 0, 0);
798 }
799
800 $black_pb->composite ($pb, $x1, $y1, $x2 - $x1 + 1, $y2 - $y1 + 1, $x1, $y1, 1, 1, INTERP_NEAREST, 192);
801}
802
803sub repaint_board {
804 my ($self) = @_;
805 my $canvas = $self->{canvas};
806 my $expose_area = undef;
807
808 return $expose_area unless $self->{board};
809
810 my ($w, $h) = @{$canvas->allocation}[2,3];
811
812 my $s = $w > $h ? $h : $w;
813
814 $self->{offsets} = [int (($w - $s) / 2), int (($h - $s) / 2), $s];
815
816 my $size = $self->{size};
817
818 my $border = int ($s / ($size + 3) * 0.5);
819 my $s2 = $s - $border * 2;
820 my $edge = int ($s2 / ($size + 1) * 0.95);
821 my $ofs = int ($edge / 2);
822
823 my @k = map int ($s2 * $_ / ($size+1) + $border + 0.5), 0 .. $size;
824
825 my $pixbuf;
826
827 my $oldboard;
828
829 if ($self->{background}) {
830 if ($oldboard = $self->{board_shown}) {
831 $pixbuf = $self->{pixbuf};
832 } else {
833 $pixbuf = $self->{background}->copy;
834 $expose_area = [0, 0, $s, $s];
835 }
836 } else {
837 $expose_area = [0, 0, $s, $s];
838
839 my ($bw, $bh) = ($::board_img->get_width, $::board_img->get_height);
840
841 if ($s < $bw && $s < $bh) {
842 $pixbuf = new_pixbuf $s, $s, $::config{conserve_memory} ? 0 : 1, 0;
843 $::board_img->copy_area (0, 0, $s, $s, $pixbuf, 0, 0);
844 } else {
845 $pixbuf = scale_pixbuf $::board_img, $s, $s, $::config{speed} ? INTERP_NEAREST : INTERP_TILES;
846 }
847
848 my $linew = int ($s / 25 / $size);
849
850 for my $i (1 .. $size) {
851 pixbuf_rect $pixbuf, $k[$i] - $linew, $k[1] - $linew, $k[$i] + $linew, $k[$size] + $linew;
852 pixbuf_rect $pixbuf, $k[1] - $linew, $k[$i] - $linew, $k[$size] + $linew, $k[$i] + $linew;
853
854 # 38 max, but we allow a bit more
855 my $label = (qw(- A B C D E F G H J K L M N O P Q R S T U V W X Y Z
856 AA BB CC DD EE FF GG HH JJ KK LL MM NN OO PP QQ RR SS TT UU VV WW XX YY ZZ))[$i];
857
858 pixbuf_text $pixbuf, 0, $k[$i], $border, $ofs, $label;
859 pixbuf_text $pixbuf, 0, $k[$i], $s2 + $border, $ofs, $label;
860 pixbuf_text $pixbuf, 0, $border, $k[$i], $ofs, $size - $i + 1;
861 pixbuf_text $pixbuf, 0, $s2 + $border, $k[$i], $ofs, $size - $i + 1;
862
863 $a++;
864 $a++ if $a eq "I"; # not correct, instead of AA AB, we should get HH JJ KK...
865 }
866
867 unless ($::config->{conserve_memory}) {
868 $self->{background} = $pixbuf;
869 $pixbuf = $pixbuf->copy;
870 }
871 }
872
873 $self->{pixbuf} = $pixbuf;
874
875 # hoshi-points(!)#d#
876 # caching of empty board gfx(!)#d#
877
878 for my $x (1 .. $size) {
879 for my $y (1 .. $size) {
880 my ($dx, $dy) = ($k[$x] - $ofs, $k[$y] - $ofs);
881 my $mark = $self->{board}{board}[$x-1][$y-1];
882 my $old = $oldboard ? $oldboard->{board}[$x-1][$y-1] : 0;
883
884 if ($oldboard && $old != $mark) {
885 my $shadow = $edge * 0.05;
886 my $new_expose = [$dx, $dy, $edge + $shadow, $edge + $shadow];
887 $self->{background}->copy_area (@$new_expose, $pixbuf, $dx, $dy);
888 $expose_area = $expose_area
889 ? Gtk::Gdk::Rectangle->union ($expose_area, $new_expose)
890 : $new_expose;
891 }
892
893 if ($mark) {
894 my $pb = $self->create_stack($mark, $edge, $x * 17 + $y * 11 );
895
896 $pb->composite ($pixbuf, $dx, $dy, $pb->get_width, $pb->get_height,
897 $dx, $dy, 1, 1, $::config{speed} ? INTERP_NEAREST : INTERP_NEAREST, 255);
898
899 # labels are handled here because they are quite rare
900 if ($mark & MARK_LABEL) {
901 my $white = $mark & (MARK_W | MARK_GRAY_W) ? 0 : 1;
902
903 if ($white) {
904 pixbuf_text $pixbuf, 0,
905 $k[$x] + $ofs * 0.1, $k[$y] + $ofs * 0.1, $ofs * 0.7,
906 $self->{board}{label}[$x-1][$y-1];
907 }
908 pixbuf_text $pixbuf, $white,
909 $k[$x], $k[$y], $ofs * 0.7,
910 $self->{board}{label}[$x-1][$y-1];
911 }
912
913 # old pixmap&mask-way. that was fast ;(
914 #my ($pm, $bm) = $self->create_stack($gc, $mark, $edge, $x * 17 + $y * 11 );
915
916 #$gc->set_clip_mask ($bm);
917 #$gc->set_clip_origin ($dx, $dy);
918 #$pixmap->draw_pixmap ($gc, $pm, 0, 0, $dx, $dy, $edge, $edge);
919 }
920 }
921 }
922
923 $self->{board_shown} = Storable::dclone $self->{board};
924 #d# save
925 #Storable::nstore { board => $self->{board}, size => $self->{size}, path => $self->{path}}, "testboard.storable";
926
927 $expose_area;
928}
929
930sub expose {
931 my ($self, $area) = @_;
932
933 if ($area && $self->{pixbuf}) {
934 my ($x, $y, $w, $h) = @$area;
935 my ($ox, $oy, $s) = @{$self->{offsets}};
936
937 $self->{pixbuf}->render_to_drawable ($self->{canvas}->window, $self->{canvas}->style->white_gc,
938 $x, $y, $x + $ox, $y + $oy, $w, $h);
939 $self->{canvas}->window->draw_rectangle ($self->{canvas}->style->black_gc, 0,
940 $x + $ox - 1, $y + $oy - 1, $w + 2, $h + 2) if $::DEBUG_EXPOSE;
941
942 #$self->{canvas}->window->draw_pixmap (
943 # $self->{canvas}->style->white_gc,
944 # $self->{pixmap},
945 # $x - $ox, $y - $oy, $x, $y, $w, $h,
946 #);
947 }
948}
949
950sub expose_event {
951 my ($widget, $self, $event) = @_;
952
953 $self->{pixbuf} or return;
954
955 my $area = $event->{area};
956 my ($ox, $oy, $s) = @{$self->{offsets}};
957
958 $self->expose (Gtk::Gdk::Rectangle->intersect (
959 [$area->[0] - $ox, $area->[1] - $oy, $area->[2], $area->[3]],
960 [0, 0, $s, $s],
961 ));
962
963 1;
964}
965
966sub event_update_tree {
967 my ($self) = @_;
968
969 $self->{path} = $self->get_path;
970
971 my $move = @{$self->{path}};
972
973 $self->{moveadj}->upper($move);
974
975 if ($self->{moveadj}->value >= $move - 1 || !$self->{moveadj}->value) {
976 $self->{moveadj}->set_value ($move);
977 }
978}
979
980sub event_part {
981 my ($self) = @_;
982 $self->SUPER::event_part;
983 $self->{window}->destroy; # hmm.. why does this keep the object alive? puzzling.. ahh.. callback ;)
984 delete $self->{room}{game}{$self->{channel}};
985}
986
987sub event_move {
988 my ($self, $pass) = @_;
989 ::play_sound $pass ? "pass" : "move";
990}
991
992sub DESTROY {#d#
993 warn "DESTROY(@_)\n";#d#
994}
995 121
9961; 1221;
997 123
998 124
999

Diff Legend

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