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

Comparing kgsueme/bin/kgsueme (file contents):
Revision 1.18 by pcg, Fri May 30 10:40:21 2003 UTC vs.
Revision 1.56 by pcg, Wed Jul 30 14:00:45 2003 UTC

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

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines