[ViewVC] Diff of: cvs/kgsueme/bin/kgsueme

Comparing kgsueme/bin/kgsueme (file contents):
Revision 1.3 by pcg, Wed May 28 22:26:25 2003 UTC vs.
Revision 1.31 by pcg, Sat May 31 06:33:13 2003 UTC

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

Diff Legend

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

Comparing kgsueme/bin/kgsueme (file contents): Revision 1.3 by pcg, Wed May 28 22:26:25 2003 UTC vs. Revision 1.31 by pcg, Sat May 31 06:33:13 2003 UTC

Diff Legend

Comparing kgsueme/bin/kgsueme (file contents):
Revision 1.3 by pcg, Wed May 28 22:26:25 2003 UTC vs.
Revision 1.31 by pcg, Sat May 31 06:33:13 2003 UTC