ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/deliantra/Deliantra-Client/bin/pclient

Comparing deliantra/Deliantra-Client/bin/pclient (file contents):
Revision 1.26 by elmex, Fri Apr 7 20:57:29 2006 UTC vs.
Revision 1.178 by root, Tue Apr 25 08:39:18 2006 UTC

1	#!/opt/bin/perl	1	#!/opt/bin/perl
2		2
3	use strict;	3	use strict;
4	use utf8;	4	use utf8;
5		5
6	use Glib;	6	BEGIN {
7	use Gtk2 -init;	7	if (%PAR::LibCache) {
		8	@INC = grep ref, @INC; # weed out all paths except pars loader refs
8		9
9	use SDL;	10	while (my ($filename, $zip) = each %PAR::LibCache) {
10	use SDL::App;	11	for ($zip->memberNames) {
		12	next unless /^\/root\/(.*)/;
		13	$zip->extractMember ($_, "$ENV{PAR_TEMP}/$1")
		14	unless -e "$ENV{PAR_TEMP}/$1";
		15	}
		16	}
		17
		18	unshift @INC, $ENV{PAR_TEMP};
		19
		20	if ($^O eq "MSWin32") {
		21	$ENV{GTK_RC_FILES} = "$ENV{PAR_TEMP}/share/themes/MS-Windows/gtk-2.0/gtkrc";
		22	}
		23	}
		24	}
		25
		26	# need to do it again because that pile of garbage called PAR nukes it before main
		27	unshift @INC, $ENV{PAR_TEMP};
		28
		29	use Time::HiRes 'time';
11	use SDL::Event;	30	use Event;
12	use SDL::Surface;
13	use SDL::OpenGL;
14	use SDL::OpenGL::Constants;
15		31
16	use Crossfire;	32	use Crossfire;
17	use Crossfire::Client;
18	use Crossfire::Protocol;	33	use Crossfire::Protocol;
19		34
20	use Crossfire::Client::Util;	35	use Compress::LZF;
21	use Crossfire::Client::Widget;
22		36
23	our $FACECACHE;	37	use CFClient;
		38	use CFClient::UI;
		39	use CFClient::MapWidget;
		40
		41	$Event::DIED = sub {
		42	CFClient::error $_[1];
		43	};
		44
		45	#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#
24		46
25	our $VERSION = '0.1';	47	our $VERSION = '0.1';
		48
		49	my $MAX_FPS = 60;
		50	my $MIN_FPS = 5; # unused as of yet
		51
		52	our $META_SERVER = "crossfire.real-time.com:13326";
		53
		54	our $FACEMAP;
		55	our $TILECACHE;
		56	our $MAPCACHE;
		57
		58	our $LAST_REFRESH;
		59	our $NOW;
26		60
27	our $CFG;	61	our $CFG;
28	our $CONN;	62	our $CONN;
		63	our $FAST; # fast, low-quality mode, possibly useful for software-rendering
29		64
		65	our @SDL_MODES;
		66	our $WIDTH;
		67	our $HEIGHT;
		68	our $FULLSCREEN;
30	our $UIFONT;	69	our $FONTSIZE;
31		70
		71	our $FONT_PROP;
		72	our $FONT_FIXED;
		73
		74	our $MAP;
		75	our $MAPWIDGET;
		76	our $BUTTONBAR;
		77	our $LOGVIEW;
		78	our $CONSOLE;
		79	our $METASERVER;
		80
		81	our $FLOORBOX;
		82	our $GAUGES;
		83	our $STATWIDS;
		84
32	our $SDL_TIMER;	85	our $SDL_ACTIVE;
33	our $SDL_APP;
34	our $SDL_EV = new SDL::Event;
35	our %SDL_CB;	86	our %SDL_CB;
36		87
37	our @GL_INIT; # hooks called on every gl init	88	our $SDL_MIXER;
		89	our @SOUNDS; # event => file mapping
		90	our %AUDIO_CHUNKS; # audio files
38		91
39	sub init_screen {	92	our $ALT_ENTER_MESSAGE;
40	$SDL_APP = new SDL::App	93	our $STATUS_LINE;
41	-flags => SDL_ANYFORMAT | SDL_HWSURFACE,	94	our $DEBUG_STATUS;
42	-title => "Crossfire+ Client",
43	-width => $CFG->{width},
44	-height => $CFG->{height},
45	-opengl => 1,
46	-red_size => 8,
47	-green_size => 8,
48	-blue_size => 8,
49	-double_buffer => 1,
50	-fullscreen => $CFG->{fullscreen},
51	-resizeable => 0;
52		95
53	glClearColor 0, 0, 0, 0;	96	sub status {
54		97	$STATUS_LINE->set_text ($_[0]);
55	glEnable GL_TEXTURE_2D;	98	$STATUS_LINE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $STATUS_LINE->{h});
56	glShadeModel GL_FLAT;
57	glDisable GL_DEPTH_TEST;
58	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
59
60	glMatrixMode GL_PROJECTION;
61	glLoadIdentity;
62	glOrtho 0, $CFG->{width}, $CFG->{height}, 0, -100 , 100;
63
64	glMatrixMode GL_MODELVIEW;
65
66	$_->() for @GL_INIT;
67	}	99	}
68		100
69	my $label;#d#	101	sub debug {
		102	$DEBUG_STATUS->set_text ($_[0]);
		103	$DEBUG_STATUS->move ($WIDTH - $DEBUG_STATUS->{w}, 0, $DEBUG_STATUS->{w}, $DEBUG_STATUS->{h});
		104	}
70		105
71	sub start_game {	106	sub start_game {
72	$SDL_TIMER = add Glib::Timeout 1000/20, sub {	107	status "logging in...";
73	while ($SDL_EV->poll) {
74	($SDL_CB{$SDL_EV->type} || sub { warn "unhandled event ", $SDL_EV->type })->();
75	}
76		108
		109	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
		110
		111	$MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";
		112
		113	$MAP = new CFClient::Map $mapsize, $mapsize;
		114
		115	my ($host, $port) = split /:/, $CFG->{host};
		116
		117	$CONN = new conn
		118	host => $host,
		119	port => $port || 13327,
		120	user => $CFG->{user},
		121	pass => $CFG->{password},
		122	mapw => $mapsize,
		123	maph => $mapsize,
		124	;
		125
		126	status "login successful";
		127
		128	CFClient::lowdelay fileno $CONN->{fh};
		129	}
		130
		131	sub stop_game {
		132	undef $CONN;
		133	}
		134
		135	sub client_setup {
		136	my $dialog = new CFClient::UI::FancyFrame
		137	title => "Client Setup",
		138	child => (my $vbox = new CFClient::UI::VBox);
		139	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
		140
		141	$table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");
		142	$table->add (1, 0, my $hbox = new CFClient::UI::HBox);
		143
		144	$hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1]);
		145	$hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");
		146
		147	$mode_slider->connect (changed => sub {
		148	my ($self, $value) = @_;
		149
		150	$CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
		151	$mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});
		152	});
		153	$mode_slider->emit (changed => $mode_slider->{range}[0]);
		154
		155	my $row = 1;
		156
		157	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
		158	$table->add (1, $row++, new CFClient::UI::CheckBox
		159	state => $CFG->{fullscreen},
		160	tooltip => "Bring the client into fullscreen mode",
		161	connect_changed => sub {
		162	my ($self, $value) = @_;
		163	$CFG->{fullscreen} = $value;
77	1	164	}
		165	);
		166
		167	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
		168	$table->add (1, $row++, new CFClient::UI::CheckBox
		169	state => $CFG->{fast},
		170	tooltip => "Lower the visual quality considerably to speed up rendering.",
		171	connect_changed => sub {
		172	my ($self, $value) = @_;
		173	$CFG->{fast} = $value;
		174	}
		175	);
		176
		177	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
		178	$table->add (1, $row++, new CFClient::UI::Slider
		179	range => [$CFG->{map_scale}, 0.25, 2, 0.05],
		180	tooltip => "Enlarge or shrink the displayed map",
		181	connect_changed => sub {
		182	my ($self, $value) = @_;
		183	$CFG->{map_scale} = 0.05 * int $value / 0.05;
		184	}
		185	);
		186
		187	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
		188	$table->add (1, $row++, new CFClient::UI::CheckBox
		189	state => $CFG->{fow_enable},
		190	tooltip => "Fog-of-War marks areas that cannot be seen by the player",
		191	connect_changed => sub {
		192	my ($self, $value) = @_;
		193	$CFG->{fow_enable} = $value;
		194	}
		195	);
		196
		197	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
		198	$table->add (1, $row++, new CFClient::UI::Slider
		199	range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001],
		200	tooltip => "The higher the intensity, the lighter the Fog-of-War color",
		201	connect_changed => sub {
		202	my ($self, $value) = @_;
		203	$CFG->{fow_intensity} = $value;
		204	}
		205	);
		206
		207	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
		208	$table->add (1, $row++, new CFClient::UI::CheckBox
		209	state => $CFG->{fow_smooth},
		210	tooltip => "Smooth the Fog-of-War a bit to make it more realistic",
		211	connect_changed => sub {
		212	my ($self, $value) = @_;
		213	$CFG->{fow_smooth} = $value;
		214	status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2;
		215	}
		216	);
		217
		218	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
		219	$table->add (1, $row++, new CFClient::UI::Slider
		220	range => [$CFG->{gui_fontsize}, 0.5, 2, 0.1],
		221	tooltip => "The font size used by most GUI elements",
		222	connect_changed => sub {
		223	$CFG->{gui_fontsize} = 0.1 * int $_[1] * 10;
		224	# $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
		225	}
		226	);
		227
		228	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Server Log Fontsize");
		229	$table->add (1, $row++, new CFClient::UI::Slider
		230	range => [$CFG->{log_fontsize}, 0.5, 2, 0.1],
		231	tooltip => "The font size used by the server log window only",
		232	connect_changed => sub {
		233	$LOGVIEW->set_fontsize ($CFG->{log_fontsize} = 0.1 * int $_[1] * 10);
		234	}
		235	);
		236
		237	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
		238
		239	$table->add (1, $row++, new CFClient::UI::Slider
		240	range => [$CFG->{stat_fontsize}, 0.5, 2, 0.1],
		241	tooltip => "The font size used by the statistics window only",
		242	connect_changed => sub {
		243	$CFG->{stat_fontsize} = 0.1 * int $_[1] * 10;
		244	&set_stats_window_fontsize;
		245	}
		246	);
		247
		248	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
		249	$table->add (1, $row++, new CFClient::UI::Slider
		250	range => [$CFG->{gauge_size}, 0.2, 0.8, 0.02],
		251	tooltip => "Adjust the size of the stats gauges at the bottom right",
		252	connect_changed => sub {
		253	$CFG->{gauge_size} = $_[1];
		254	my $h = int $HEIGHT * $CFG->{gauge_size};
		255	$GAUGES->{win}->set_size ($WIDTH, $h);
		256	$GAUGES->{win}->move (0, $HEIGHT - $h);
		257	}
		258	);
		259
		260	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
		261	$table->add (1, $row++, new CFClient::UI::Slider
		262	range => [$CFG->{gauge_fontsize}, 0.5, 2.0, 0.1],
		263	tooltip => "Adjusts the fontsize of the gauges at the bottom right",
		264	connect_changed => sub {
		265	$CFG->{gauge_fontsize} = 0.1 * int $_[1] * 10;
		266	&set_gauge_window_fontsize;
		267	}
		268	);
		269
		270	$table->add (1, $row++, new CFClient::UI::Button
		271	expand => 1, align => 0, text => "Apply",
		272	tooltip => "Apply the video settings",
		273	connect_activate => sub {
		274	video_shutdown ();
		275	video_init ();
		276	}
		277	);
		278
		279	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");
		280	$table->add (1, $row++, new CFClient::UI::CheckBox
		281	state => $CFG->{audio_enable},
		282	tooltip => "If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.",
		283	connect_changed => sub {
		284	$CFG->{audio_enable} = $_[1];
		285	}
		286	);
		287	# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume");
		288	# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], connect_changed => sub {
		289	# $CFG->{effects_volume} = $_[1];
		290	# });
		291	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");
		292	$table->add (1, $row++, my $hbox = new CFClient::UI::HBox);
		293	$hbox->add (new CFClient::UI::CheckBox
		294	expand => 1, state => $CFG->{bgm_enable},
		295	tooltip => "Enable background music playing",
		296	connect_changed => sub {
		297	$CFG->{bgm_enable} = $_[1];
		298	}
		299	);
		300	$hbox->add (new CFClient::UI::Slider
		301	expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0.1],
		302	tooltip => "The volume of the background music",
		303	connect_changed => sub {
		304	$CFG->{bgm_volume} = $_[1];
		305	CFClient::MixMusic::volume $_[1] * 128;
		306	}
		307	);
		308
		309	$table->add (1, $row++, new CFClient::UI::Button
		310	expand => 1, align => 0, text => "Apply",
		311	tooltip => "Apply the audio settings",
		312	connect_activate => sub {
		313	audio_shutdown ();
		314	audio_init ();
		315	}
		316	);
		317
		318	$dialog
		319	}
		320
		321	sub set_stats_window_fontsize {
		322	for (values %{$STATWIDS}) {
		323	$_->set_fontsize ($::CFG->{stat_fontsize});
		324	}
		325	}
		326
		327	sub set_gauge_window_fontsize {
		328	for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {
		329	$_->set_fontsize ($::CFG->{gauge_fontsize});
		330	}
		331
		332	# local $GAUGES->{win}{parent};#d#
		333	# use PApp::Util; open D, ">:utf8", "d"; print D PApp::Util::dumpval $GAUGES->{win}; close D;
		334	}
		335
		336	sub make_gauge_window {
		337	my $gh = int ($HEIGHT * $CFG->{gauge_size});
		338	# my $gw = int ($WIDTH * $CFG->{gauge_w_size});
		339
		340	my $win = new CFClient::UI::Frame (
		341	y => $HEIGHT - $gh, x => 0, user_w => $WIDTH, user_h => $gh
		342	);
		343	$win->add (my $hbox = new CFClient::UI::HBox
		344	children => [
		345	(new CFClient::UI::HBox expand => 1),
		346	($FLOORBOX = new CFClient::UI::VBox),
		347	(my $vbox = new CFClient::UI::VBox),
		348	],
		349	);
		350
		351	$vbox->add (new CFClient::UI::HBox
		352	expand => 1,
		353	children => [
		354	(new CFClient::UI::Empty expand => 1),
		355	(my $hb = new CFClient::UI::HBox),
		356	],
		357	);
		358
		359	$hb->add (my $hg = new CFClient::UI::Gauge type => 'hp',
		360	tooltip => "Health points - depletes when you get wounded, refills when you heal or idle");
		361	$hb->add (my $mg = new CFClient::UI::Gauge type => 'mana',
		362	tooltip => "Spell points - deplete when you cast wizard spells, refills when you idle");
		363	$hb->add (my $gg = new CFClient::UI::Gauge type => 'grace',
		364	tooltip => "Grace points - deplete when you cast priest spells, refills when you pray");
		365	$hb->add (my $fg = new CFClient::UI::Gauge type => 'food',
		366	tooltip => "Food - depletes with time, faster when you heal or build mana, refills when you eat healthy food");
		367
		368	$vbox->add (my $exp = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
		369	tooltip => "Experience points and level - increases when you kill monsters or successfully use skills");
		370	$vbox->add (my $rng = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
		371	tooltip => "Ranged attack - how you attack when you press shift-cursor (spell, skill, weapon etc.)");
		372
		373	$GAUGES = {
		374	exp => $exp, win => $win, range => $rng,
		375	food => $fg, mana => $mg, hp => $hg, grace => $gg
78	};	376	};
79		377
80	init_screen;	378	&set_gauge_window_fontsize;
81		379
82	$label = new Crossfire::Client::Widget::Label 500, 10, 1, $UIFONT, "Testü[]";	380	$win
83	$label->activate;	381	}
84		382
85	$CONN = new conn	383	sub make_stats_window {
		384	my $tgw = new CFClient::UI::FancyFrame (x => $WIDTH * 2/5, y => 0, title => "Stats");
		385
		386	$tgw->add (my $vb = new CFClient::UI::VBox);
		387	$vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1);
		388	$vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1);
		389
		390	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
		391
		392	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);
		393
		394	my $black = [0, 0, 0];
		395
		396	$tbl->add (0, 0, $STATWIDS->{st_str} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
		397	$tbl->add (0, 1, $STATWIDS->{st_dex} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
		398	$tbl->add (0, 2, $STATWIDS->{st_con} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
		399	$tbl->add (0, 3, $STATWIDS->{st_int} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
		400	$tbl->add (0, 4, $STATWIDS->{st_wis} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
		401	$tbl->add (0, 5, $STATWIDS->{st_pow} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
		402	$tbl->add (0, 6, $STATWIDS->{st_cha} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
		403
		404	$tbl->add (1, 0, $STATWIDS->{st_str_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Str");
		405	$tbl->add (1, 1, $STATWIDS->{st_dex_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Dex");
		406	$tbl->add (1, 2, $STATWIDS->{st_con_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Con");
		407	$tbl->add (1, 3, $STATWIDS->{st_int_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Int");
		408	$tbl->add (1, 4, $STATWIDS->{st_wis_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Wis");
		409	$tbl->add (1, 5, $STATWIDS->{st_pow_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Pow");
		410	$tbl->add (1, 6, $STATWIDS->{st_cha_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Cha");
		411
		412	$tbl->add (2, 0, $STATWIDS->{st_wc} = new CFClient::UI::Label valign => 0, align => +1, template => "-120");
		413	$tbl->add (2, 1, $STATWIDS->{st_ac} = new CFClient::UI::Label valign => 0, align => +1, template => "-120");
		414	$tbl->add (2, 2, $STATWIDS->{st_dam} = new CFClient::UI::Label valign => 0, align => +1, template => "120");
		415	$tbl->add (2, 3, $STATWIDS->{st_arm} = new CFClient::UI::Label valign => 0, align => +1, template => "120");
		416	$tbl->add (2, 4, $STATWIDS->{st_spd} = new CFClient::UI::Label valign => 0, align => +1, template => "10.54");
		417	$tbl->add (2, 5, $STATWIDS->{st_wspd} = new CFClient::UI::Label valign => 0, align => +1, template => "9");
		418
		419	$tbl->add (3, 0, $STATWIDS->{st_wc_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Wc");
		420	$tbl->add (3, 1, $STATWIDS->{st_ac_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Ac");
		421	$tbl->add (3, 2, $STATWIDS->{st_dam_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Dam");
		422	$tbl->add (3, 3, $STATWIDS->{st_arm_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Arm");
		423	$tbl->add (3, 4, $STATWIDS->{st_spd_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Sp");
		424	$tbl->add (3, 5, $STATWIDS->{st_wspd_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "WSp");
		425
		426	$hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);
		427
		428	my $row = 0;
		429	my $col = 0;
		430
		431	my %resist_names = (
		432	slow => "Slow",
		433	holyw => "Holy Word",
		434	conf => "Confusion",
		435	fire => "Fire",
		436	depl => "Depletion",
		437	magic => "Magic",
		438	drain => "Draining",
		439	acid => "Acid",
		440	pois => "Poison",
		441	para => "Paralysation",
		442	deat => "Death",
		443	phys => "Physical",
		444	blind => "Blind",
		445	fear => "Fear",
		446	tund => "Turn undead",
		447	elec => "Electricity",
		448	cold => "Cold",
		449	ghit => "Ghost hit",
		450	);
		451	for (qw/slow holyw conf fire depl magic
		452	drain acid pois para deat phys
		453	blind fear tund elec cold ghit/)
		454	{
		455	$tbl2->add ($col, $row,
		456	$STATWIDS->{"res_$_"} =
		457	new CFClient::UI::Label
		458	template => "-100%",
		459	align => +1,
		460	valign => 0,
		461	tooltip => $resist_names{$_}
		462	);
		463	$tbl2->add ($col + 1, $row, new CFClient::UI::Image
		464	can_hover => 1,
		465	can_events => 1,
		466	image => "ui/resist/resist_$_.png",
		467	tooltip => $resist_names{$_}
		468	);
		469
		470	$row++;
		471	if ($row % 6 == 0) {
		472	$col += 2;
		473	$row = 0;
		474	}
		475	}
		476
		477	&set_stats_window_fontsize;
		478	update_stats_window ({});
		479
		480	$tgw
		481	}
		482
		483	sub formsep {
		484	reverse join ",", grep length, split /(...)/, reverse $_[0] * 1
		485	}
		486
		487	sub update_stats_window {
		488	my ($stats) = @_;
		489
		490	# i love text protocols!!!
		491	my $hp = $stats->{Crossfire::Protocol::CS_STAT_HP} * 1;
		492	my $hp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXHP} * 1;
		493	my $sp = $stats->{Crossfire::Protocol::CS_STAT_SP} * 1;
		494	my $sp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXSP} * 1;
		495	my $fo = $stats->{Crossfire::Protocol::CS_STAT_FOOD} * 1;
		496	my $fo_m = 999;
		497	my $gr = $stats->{Crossfire::Protocol::CS_STAT_GRACE} * 1;
		498	my $gr_m = $stats->{Crossfire::Protocol::CS_STAT_MAXGRACE} * 1;
		499
		500	$GAUGES->{hp} ->set_value ($hp, $hp_m);
		501	$GAUGES->{mana} ->set_value ($sp, $sp_m);
		502	$GAUGES->{food} ->set_value ($fo, $fo_m);
		503	$GAUGES->{grace} ->set_value ($gr, $gr_m);
		504	$GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::CS_STAT_EXP64})
		505	. " (lvl " . ($stats->{Crossfire::Protocol::CS_STAT_LEVEL} * 1) . ")");
		506	my $rng = $stats->{Crossfire::Protocol::CS_STAT_RANGE};
		507	$rng =~ s/^Range: //; # thank you so much dear server
		508	$GAUGES->{range} ->set_text ("Rng: " . $rng);
		509	my $title = $stats->{Crossfire::Protocol::CS_STAT_TITLE};
		510	$title =~ s/^Player: //;
		511	$STATWIDS->{title} ->set_text ("Title: " . $title);
		512
		513	$STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});
		514	$STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});
		515	$STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9});
		516	$STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6});
		517	$STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7});
		518	$STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22});
		519	$STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});
		520	$STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13});
		521	$STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14});
		522	$STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});
		523	$STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});
		524	$STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_SPEED});
		525	$STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_WEAP_SP});
		526
		527	my %tbl = (
		528	phys => 100,
		529	magic => 101,
		530	fire => 102,
		531	elec => 103,
		532	cold => 104,
		533	conf => 105,
		534	acid => 106,
		535	drain => 107,
		536	ghit => 108,
		537	pois => 109,
		538	slow => 110,
		539	para => 111,
		540	tund => 112,
		541	fear => 113,
		542	depl => 113,
		543	deat => 115,
		544	holyw => 116,
		545	blind => 117
		546	);
		547
		548	for (keys %tbl) {
		549	$STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}});
		550	}
		551
		552	}
		553
		554	sub metaserver_dialog {
		555	my $dialog = new CFClient::UI::FancyFrame
		556	title => "Metaserver",
		557	child => (my $vbox = new CFClient::UI::VBox);
		558
		559	$vbox->add ($dialog->{table} = new CFClient::UI::Table);
		560
		561	$dialog
		562	}
		563
		564	sub update_metaserver {
		565	my ($HOST) = @_;
		566
		567	my $table = $METASERVER->{table};
		568	$table->clear;
		569	$table->add (0, 0, my $label = new CFClient::UI::Label max_w => $WIDTH * 0.8, text => "fetching metaserver list...");
		570
		571	my $buf;
		572
		573	my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;
		574
		575	unless ($fh) {
		576	$label->set_text ("unable to contact metaserver: $!");
		577	return;
		578	}
		579
		580	Event->io (fd => $fh, poll => 'r', cb => sub {
		581	my $res = sysread $fh, $buf, 8192, length $buf;
		582
		583	if (!defined $res) {
		584	$_[0]->w->cancel;
		585	$label->set_text ("error while retrieving server list: $!");
		586	} elsif ($res == 0) {
		587	$_[0]->w->cancel;
		588	status "server list retrieved";
		589
		590	utf8::decode $buf if utf8::valid $buf;
		591
		592	$table->clear;
		593
		594	my @col = qw(Use #Users Host Uptime Version Description);
		595	$table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])
		596	for 0 .. $#col;
		597
		598	my @align = qw(1 0 1 1 -1);
		599
		600	my $y = 0;
		601	for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) {
		602	my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m;
		603
		604	for ($desc) {
		605	s/<br>/\n/gi;
		606	s/<li>/\n· /gi;
		607	s/<.*?>//sgi;
		608	s/&/&amp;/g;
		609	s/</&lt;/g;
		610	s/>/&gt;/g;
		611	}
		612
		613	$uptime = sprintf "%dd %02d:%02d:%02d",
		614	(int $m->[8] / 86400),
		615	(int $m->[8] / 3600) % 24,
		616	(int $m->[8] / 60) % 60,
		617	$m->[8] % 60;
		618
		619	$m = [$users, $host, $uptime, $version, $desc];
		620
		621	$y++;
		622
		623	$table->add (0, $y, new CFClient::UI::VBox children => [
		624	(new CFClient::UI::Button text => "Use", connect_activate => sub {
		625	$HOST->set_text ($CFG->{host} = $host);
		626	}),
		627	(new CFClient::UI::Empty expand => 1),
		628	]);
		629
		630	$table->add ($_ + 1, $y, new CFClient::UI::Label align => $align[$_], text => $m->[$_], fontsize => 0.8)
		631	for 0 .. $#$m;
		632	}
		633	}
		634	});
		635	}
		636
		637	sub server_setup {
		638	my $dialog = new CFClient::UI::FancyFrame
		639	title => "Server Setup",
		640	child => (my $vbox = new CFClient::UI::VBox);
		641
		642	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
		643	$table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
		644
		645	{
		646	$table->add (1, 2, my $vbox = new CFClient::UI::VBox);
		647
		648	$vbox->add (
		649	my $HOST = new CFClient::UI::Entry
		650	expand => 1,
86	host => $CFG->{host},	651	text => $CFG->{host},
		652	tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
		653	connect_changed => sub {
		654	my ($self, $value) = @_;
		655	$CFG->{host} = $value;
		656	}
		657	);
		658
		659	$METASERVER = metaserver_dialog;
		660
		661	$vbox->add (new CFClient::UI::Flopper
		662	expand => 1,
		663	text => "Metaserver",
		664	other => $METASERVER,
		665	tooltip => "Show a list of avaible crossfire servers",
		666	connect_open => sub {
		667	update_metaserver $HOST;
		668	}
		669	);
		670	}
		671
		672	$table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
		673	$table->add (1, 4, new CFClient::UI::Entry
		674	text => $CFG->{user},
		675	tooltip => "The name of your character on the server",
		676	connect_changed => sub {
		677	my ($self, $value) = @_;
		678	$CFG->{user} = $value;
		679	}
		680	);
		681
		682	$table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
		683	$table->add (1, 5, new CFClient::UI::Entry
87	port => $CFG->{port};	684	text => $CFG->{password},
88	}	685	hidden => 1,
		686	tooltip => "The password for your character",
		687	connect_changed => sub {
		688	my ($self, $value) = @_;
		689	$CFG->{password} = $value;
		690	}
		691	);
89		692
90	sub stop_game {	693	$table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "Def. say cmd");
91	remove Glib::Source $SDL_TIMER;	694	$table->add (1, 6, my $saycmd = new CFClient::UI::Entry
		695	text => $CFG->{say_command},
		696	tooltip => "This is the command that will be used if you write a line in the message window entry. "
		697	."Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
		698	."But you could also set it to 'tell &lt;playername&gt;' to only chat with that user.",
		699	connect_changed => sub {
		700	my ($self, $value) = @_;
		701	$CFG->{say_command} = $value;
		702	}
		703	);
92		704
		705	$table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
		706	$table->add (1, 7, new CFClient::UI::Slider
		707	req_w => 100,
		708	range => [$CFG->{mapsize}, 10, 100 + 1, 1],
		709	tooltip => "This is the size of the portion of the map update the server sends you. "
		710	."If you set this to a high value you will be able to see further for example.",
		711	connect_changed => sub {
		712	my ($self, $value) = @_;
		713
		714	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;
		715	},
		716	);
		717
		718	$table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Login", connect_activate => sub {
		719	start_game;
		720	});
		721
		722	$dialog
		723	}
		724
		725	sub message_window {
		726	my $window = new CFClient::UI::FancyFrame
		727	title => "Messages",
		728	border_bg => [1, 1, 1, 0.5],
		729	bg => [0.3, 0.3, 0.3, 0.8],
		730	user_w => int $::WIDTH / 3,
		731	user_h => int $::HEIGHT / 5,
		732	child => (my $vbox = new CFClient::UI::VBox);
		733
		734	$vbox->add ($LOGVIEW = new CFClient::UI::TextView
		735	expand => 1,
		736	font => $FONT_FIXED,
		737	fontsize => $::CFG->{log_fontsize},
		738	);
		739
		740	$vbox->add (my $input = new CFClient::UI::Entry
		741	connect_focus_in => sub {
		742	my ($input, $prev_focus) = @_;
		743
		744	delete $input->{refocus_map};
		745
		746	if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
		747	$input->{refocus_map} = 1;
		748	}
		749	delete $input->{auto_activated};
		750	},
		751	connect_activate => sub {
		752	my ($input, $text) = @_;
		753	$input->set_text ('');
		754
		755	if ($text =~ /^\/(.*)/) {
		756	$::CONN->user_send ($1);
		757	} else {
		758	my $say_cmd = $::CFG->{say_command} || 'say';
		759	$::CONN->user_send ("$say_cmd $text");
		760	}
		761	if ($input->{refocus_map}) {
		762	delete $input->{refocus_map};
		763	$MAPWIDGET->focus_in
		764	}
		765	},
		766	connect_escape => sub {
		767	$MAPWIDGET->focus_in
		768	},
		769	);
		770
		771	$CONSOLE = {
		772	window => $window,
		773	input => $input
		774	};
		775
		776	$window
		777	}
		778
		779	sub sdl_init {
		780	CFClient::SDL_Init
		781	and die "SDL::Init failed!\n";
		782	}
		783
		784	sub video_init {
		785	sdl_init;
		786
		787	($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
		788	$FULLSCREEN = $CFG->{fullscreen};
		789	$FAST = $CFG->{fast};
		790
		791	CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
		792	or die "SDL_SetVideoMode failed!\n";
		793
		794	$SDL_ACTIVE = 1;
		795
		796	$LAST_REFRESH = time - 0.01;
		797
		798	CFClient::gl_init;
		799
		800	$FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
		801
		802	#############################################################################
		803
		804	$DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100;
		805	$DEBUG_STATUS->show;
		806
		807	$STATUS_LINE = new CFClient::UI::Label
		808	padding => 0,
		809	y => $HEIGHT - $FONTSIZE * 1.8;
		810	$STATUS_LINE->show;
		811
		812	$ALT_ENTER_MESSAGE = new CFClient::UI::Label
		813	padding => 0,
		814	fontsize => 0.8,
		815	markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode";
		816	$ALT_ENTER_MESSAGE->show;
		817	$ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h});
		818
		819	$CFClient::UI::ROOT->add ($MAPWIDGET = new CFClient::MapWidget);
		820	$MAPWIDGET->focus_in;
		821	$MAPWIDGET->connect (activate_console => sub {
		822	my ($mapwidget, $preset) = @_;
		823
		824	if ($CONSOLE) {
		825	$CONSOLE->{input}->{auto_activated} = 1;
		826	$CONSOLE->{input}->focus_in;
		827
		828	if ($preset && $CONSOLE->{input}->get_text eq '') {
		829	$CONSOLE->{input}->set_text ($preset);
		830	}
		831	}
		832	});
		833
		834	$CFClient::UI::ROOT->add ($BUTTONBAR = new CFClient::UI::HBox);
		835
		836	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup);
		837	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup);
		838	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);
		839
		840	$CFClient::UI::ROOT->add (make_gauge_window); # XXX: this has to be set before make_stats_window as make_stats_window calls update_stats_window which updated the gauges also X-D
		841	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window);
		842
		843	$BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {
		844	CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
		845	status "Configuration Saved";
		846	});
		847
		848	$BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
		849	}
		850
		851	sub video_shutdown {
		852	$CFClient::UI::ROOT->{children} = [];
		853	undef $CFClient::UI::GRAB;
		854	undef $CFClient::UI::HOVER;
93	undef $SDL_APP;	855	undef $SDL_ACTIVE;
94	SDL::Quit;
95	}	856	}
		857
		858	my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
		859	my $bgmusic;#TODO#hack#d#
		860
		861	sub audio_music_finished {
		862	return unless $CFG->{bgm_enable};
		863
		864	# TODO: hack, do play loop and mood music
		865	$bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/$bgmusic[0]";
		866	$bgmusic->play (0);
		867
		868	push @bgmusic, shift @bgmusic;
		869	}
		870
		871	sub audio_init {
		872	if ($CFG->{audio_enable}) {
		873	if (open my $fh, "<:utf8", CFClient::find_rcfile "sounds/config") {
		874	$SDL_MIXER = !CFClient::Mix_OpenAudio;
		875	CFClient::Mix_AllocateChannels 8;
		876	CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
		877
		878	audio_music_finished;
		879
		880	while (<$fh>) {
		881	next if /^\s*#/;
		882	next if /^\s*$/;
		883
		884	my ($file, $volume, $event) = split /\s+/, $_, 3;
		885
		886	push @SOUNDS, "$volume,$file";
		887
		888	$AUDIO_CHUNKS{"$volume,$file"} ||= do {
		889	my $chunk = new_from_file CFClient::MixChunk CFClient::find_rcfile "sounds/$file";
		890	$chunk->volume ($volume * 128 / 100);
		891	$chunk
		892	};
		893	}
		894	} else {
		895	status "unable to open sound config: $!";
		896	}
		897	}
		898	}
		899
		900	sub audio_shutdown {
		901	CFClient::Mix_CloseAudio if $SDL_MIXER;
		902	undef $SDL_MIXER;
		903	@SOUNDS = ();
		904	%AUDIO_CHUNKS = ();
		905	}
		906
		907	my %animate_object;
		908	my $animate_timer;
		909
		910	my $want_refresh;
		911	my $can_refresh;
		912
		913	my $fps = 9;
		914
		915	sub force_refresh {
		916	$fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05;
		917	debug sprintf "%3.2f", $fps;
		918
		919	$want_refresh = 0;
		920	$can_refresh = 0;
		921
		922	$CFClient::UI::ROOT->draw;
		923
		924	CFClient::SDL_GL_SwapBuffers;
		925
		926	$LAST_REFRESH = $NOW;
		927	}
		928
		929	my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {
		930	$NOW = time;
		931
		932	($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
		933	for CFClient::SDL_PollEvent;
		934
		935	if (%animate_object) {
		936	$_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
		937	$want_refresh++;
		938	}
		939
		940	if ($want_refresh) {
		941	force_refresh;
		942	} else {
		943	$can_refresh = 1;
		944	}
		945	});
96		946
97	sub refresh {	947	sub refresh {
98	glClear GL_COLOR_BUFFER_BIT;	948	$want_refresh++;
99
100	$_->draw for @Crossfire::Client::Widget::ACTIVE_WIDGETS;
101
102	SDL::GLSwapBuffers;
103	}	949	}
104		950
105	%SDL_CB = (	951	sub animation_start {
106	SDL_QUIT() => sub {	952	my ($widget) = @_;
107	main_quit Gtk2;	953	$animate_object{$widget} = $widget;
108	},	954	}
109	SDL_VIDEORESIZE() => sub {	955
110	},	956	sub animation_stop {
111	SDL_VIDEOEXPOSE() => sub {	957	my ($widget) = @_;
112	refresh;	958	delete $animate_object{$widget};
113	},	959	}
114	SDL_KEYDOWN() => sub {
115	if ($SDL_EV->key_mod & KMOD_ALT && $SDL_EV->key_sym == SDLK_RETURN) {
116	# alt-enter
117	$CFG->{fullscreen} = !$CFG->{fullscreen};
118	init_screen;
119	} else {
120	Crossfire::Client::Widget::feed_sdl_key_down_event ($SDL_EV);
121	}
122	},
123	SDL_KEYUP() => sub {
124	Crossfire::Client::Widget::feed_sdl_key_up_event ($SDL_EV);
125	},
126	SDL_MOUSEMOTION() => sub {
127	warn "sdl motion\n";#d#
128	},
129	SDL_MOUSEBUTTONDOWN() => sub {
130	Crossfire::Client::Widget::feed_sdl_button_down_event ($SDL_EV);
131	},
132	SDL_MOUSEBUTTONUP() => sub {
133	Crossfire::Client::Widget::feed_sdl_button_up_event ($SDL_EV);
134	},
135	SDL_ACTIVEEVENT() => sub {
136	warn "active\n";#d#
137	},
138	);
139		960
140	@conn::ISA = Crossfire::Protocol::;	961	@conn::ISA = Crossfire::Protocol::;
141		962
142	sub conn::map_update {	963	sub conn::stats_update {
143	my ($self, $dirty) = @_;	964	my ($self, $stats) = @_;
144		965
145	refresh;	966	update_stats_window ($stats);
		967	}
		968
		969	sub conn::user_send {
		970	my ($self, $command) = @_;
		971
		972	$self->send_command ($command);
		973	status $command;
146	}	974	}
147		975
148	sub conn::map_scroll {	976	sub conn::map_scroll {
149	my ($self, $dx, $dy) = @_;	977	my ($self, $dx, $dy) = @_;
150		978
151	refresh;	979	$MAP->scroll ($dx, $dy);
		980	}
		981
		982	sub conn::feed_map1a {
		983	my ($self, $data) = @_;
		984
		985	# $self->Crossfire::Protocol::feed_map1a ($data);
		986
		987	$MAP->map1a_update ($data);
		988	$MAPWIDGET->update;
		989	}
		990
		991	sub conn::flush_map {
		992	my ($self) = @_;
		993
		994	my $map_info = delete $self->{map_info}
		995	or return;
		996
		997	my ($hash, $x, $y, $w, $h) = @$map_info;
		998
		999	my $data = $MAP->get_rect ($x, $y, $w, $h);
		1000	$MAPCACHE->put ($hash => Compress::LZF::compress $data);
		1001	#warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
152	}	1002	}
153		1003
154	sub conn::map_clear {	1004	sub conn::map_clear {
155	my ($self) = @_;	1005	my ($self) = @_;
156		1006
		1007	$self->flush_map;
		1008	delete $self->{neigh_map};
		1009
		1010	$MAP->clear;
		1011	}
		1012
		1013
		1014	sub conn::load_map($$$) {
		1015	my ($self, $hash, $x, $y) = @_;
		1016
		1017	if (defined (my $data = $MAPCACHE->get ($hash))) {
		1018	$data = Compress::LZF::decompress $data;
		1019	#warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
		1020	for my $id ($MAP->set_rect ($x, $y, $data)) {
		1021	my $data = $TILECACHE->get ($id)
		1022	or next;
		1023
		1024	$self->set_texture ($id => $data);
		1025	}
		1026	}
		1027	}
		1028
		1029	# this method does a "flood fill" into every tile direction
		1030	# it assumes that tiles are arranged in a rectangular grid,
		1031	# i.e. a map is the same as the left of the right map etc.
		1032	# failure to comply are harmless and result in display errors
		1033	# at worst.
		1034	sub conn::flood_fill {
		1035	my ($self, $gx, $gy, $path, $hash, $flags) = @_;
		1036
		1037	# the server does not allow map paths > 6
		1038	return if 6 <= length $path;
		1039
		1040	my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
		1041
		1042	for (
		1043	[1, 0, -1],
		1044	[2, 1, 0],
		1045	[3, 0, 1],
		1046	[4, -1, 0],
		1047	) {
		1048	my ($tile, $dx, $dy) = @$_;
		1049
		1050	my $gx = $gx + $dx;
		1051	my $gy = $gy + $dy;
		1052
		1053	next unless $flags & (1 << ($tile - 1));
		1054	next if $self->{neigh_grid}{$gx, $gy}++;
		1055
		1056	my $neigh = $self->{neigh_map}{$hash} ||= [];
		1057	if (my $info = $neigh->[$tile]) {
		1058	my ($flags, $x, $y, $w, $h, $hash) = @$info;
		1059
		1060	$self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags)
		1061	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
		1062
		1063	} else {
		1064	$self->send_mapinfo ("spatial $path$tile", sub {
		1065	my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
		1066
		1067	return if $mode ne "spatial";
		1068
		1069	$x += $MAP->ox;
		1070	$y += $MAP->oy;
		1071
		1072	$self->load_map ($hash, $x, $y)
		1073	unless $self->{neigh_map}{$hash}[5]++;#d#
		1074
		1075	$neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
		1076
		1077	$self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags)
		1078	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
		1079	});
		1080	}
		1081	}
		1082	}
		1083
		1084	sub conn::map_change {
		1085	my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
		1086
		1087	$self->flush_map;
		1088
		1089	my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
		1090
		1091	my $mapmapw = 250;
		1092	my $mapmaph = 250;
		1093
		1094	$self->{neigh_rect} = [
		1095	$ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
		1096	$ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
		1097	];
		1098
		1099	delete $self->{neigh_grid};
		1100	$self->flood_fill (0, 0, "", $hash, $flags);
		1101
		1102	$x += $ox;
		1103	$y += $oy;
		1104
		1105	$self->{map_info} = [$hash, $x, $y, $w, $h];
		1106
		1107	my $map = $self->{map_info}[0];
		1108	$map =~ s/^.*?\/([^\/]+)$/\1/;
		1109	$STATWIDS->{map}->set_text ("Map: " . $map);
		1110
		1111	$self->load_map ($hash, $x, $y);
		1112	}
		1113
		1114	sub conn::face_find {
		1115	my ($self, $facenum, $face) = @_;
		1116
		1117	my $hash = "$face->{chksum},$face->{name}";
		1118
		1119	my $id = $FACEMAP->get ($hash);
		1120
		1121	unless ($id) {
		1122	# create new id for face
		1123	# i love transactions
		1124	for (1..100) {
		1125	my $txn = $CFClient::DB_ENV->txn_begin;
		1126	my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);
		1127	if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
		1128	$id++;
		1129	if ($FACEMAP->put (id => $id) == 0
		1130	&& $FACEMAP->put ($hash => $id) == 0) {
		1131	$txn->txn_commit;
		1132
		1133	goto gotid;
		1134	}
		1135	}
		1136	$txn->abort;
		1137	}
		1138
		1139	CFClient::fatal "maximum number of transaction retries reached - database problems?";
		1140	}
		1141
		1142	gotid:
		1143	$face->{id} = $id;
		1144	$MAP->set_face ($facenum => $id);
		1145	$self->{faceid}[$facenum] = $id;#d#
		1146	$TILECACHE->get ($id)
		1147	}
		1148
		1149	sub conn::face_update {
		1150	my ($self, $facenum, $face) = @_;
		1151
		1152	$TILECACHE->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes
		1153
		1154	$self->set_texture ($face->{id} => delete $face->{image});
		1155	}
		1156
		1157	sub conn::set_texture {
		1158	my ($self, $id, $data) = @_;
		1159
		1160	$self->{texture}[$id] ||= do {
		1161	my $tex =
		1162	new_from_image CFClient::Texture
		1163	$data, minify => 1, mipmap => 1;
		1164
		1165	$MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
		1166	$MAPWIDGET->update;
		1167
		1168	$tex
		1169	};
		1170	}
		1171
		1172	sub conn::sound_play {
		1173	my ($self, $x, $y, $soundnum, $type) = @_;
		1174
		1175	$SDL_MIXER
		1176	or return;
		1177
		1178	my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
		1179	or return;
		1180
		1181	$chunk->play;
		1182	# warn "sound $x,$y,$soundnum,$type\n";#d#
		1183	}
		1184
		1185	my $LAST_QUERY; # server is stupid, stupid, stupid
		1186
		1187	sub conn::query {
		1188	my ($self, $flags, $prompt) = @_;
		1189
		1190	$prompt = $LAST_QUERY unless length $prompt;
		1191	$LAST_QUERY = $prompt;
		1192
		1193	my $dialog = new CFClient::UI::FancyFrame
		1194	title => "Query",
		1195	child => my $vbox = new CFClient::UI::VBox;
		1196
		1197	$vbox->add (new CFClient::UI::Label
		1198	max_w => $::WIDTH * 0.4,
		1199	text => $prompt);
		1200
		1201	if ($flags & Crossfire::Protocol::CS_QUERY_YESNO) {
		1202	$vbox->add (my $hbox = new CFClient::HBox);
		1203	$hbox->add (new CFClient::Button
		1204	text => "No",
		1205	connect_activate => sub {
		1206	$self->send ("reply n");
		1207	$dialog->destroy;
		1208	$MAPWIDGET->focus_in;
		1209	}
		1210	);
		1211	$hbox->add (new CFClient::Button
		1212	text => "Yes",
		1213	connect_activate => sub {
		1214	$self->send ("reply y");
		1215	$dialog->destroy;
		1216	$MAPWIDGET->focus_in;
		1217	},
		1218	);
		1219
		1220	$dialog->focus_in;
		1221
		1222	} elsif ($flags & Crossfire::Protocol::CS_QUERY_SINGLECHAR) {
		1223	$dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";
		1224	$vbox->add (my $entry = new CFClient::UI::Entry
		1225	connect_changed => sub {
		1226	$self->send ("reply $_[1]");
		1227	$dialog->destroy;
		1228	$MAPWIDGET->focus_in;
		1229	},
		1230	);
		1231
		1232	$entry->focus_in;
		1233
		1234	} else {
		1235	$dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
		1236
		1237	$vbox->add (my $entry = new CFClient::UI::Entry
		1238	$flags & Crossfire::Protocol::CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (),
		1239	connect_activate => sub {
		1240	$self->send ("reply $_[1]");
		1241	$dialog->destroy;
		1242	$MAPWIDGET->focus_in;
		1243	},
		1244	);
		1245
		1246	$entry->focus_in;
		1247	}
		1248
		1249	$dialog->show;
		1250	}
		1251
		1252	sub conn::drawinfo {
		1253	my ($self, $color, $text) = @_;
		1254
		1255	my @color = (
		1256	[1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
		1257	[1.00, 1.00, 1.00],
		1258	[0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]
		1259	[1.00, 0.00, 0.00],
		1260	[1.00, 0.54, 0.00],
		1261	[0.11, 0.56, 1.00],
		1262	[0.93, 0.46, 0.00],
		1263	[0.18, 0.54, 0.34],
		1264	[0.56, 0.73, 0.56],
		1265	[0.80, 0.80, 0.80],
		1266	[0.55, 0.41, 0.13],
		1267	[0.99, 0.77, 0.26],
		1268	[0.74, 0.65, 0.41],
		1269	);
		1270
		1271	$LOGVIEW->add_paragraph ($color[$color], $text);
		1272	}
		1273
		1274	sub conn::spell_add {
		1275	my ($self, $spell) = @_;
		1276
		1277	# TODO
		1278	# create a widget dynamically, using spell face (CF::Protocol downloads them)
		1279	$MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message});
		1280	$MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message});
		1281	}
		1282
		1283	sub conn::spell_delete {
		1284	my ($self, $spell) = @_;
		1285	}
		1286
		1287	sub conn::addme_success {
		1288	my ($self) = @_;
		1289
		1290	for my $skill (values %{$self->{skill_info}}) {
		1291	$MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'");
		1292	$MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'");
		1293	}
		1294	}
		1295
		1296	sub update_floorbox {
		1297	$CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
		1298	$FLOORBOX->clear;
		1299	$FLOORBOX->add (new CFClient::UI::Empty expand => 1);
		1300
		1301	my @items = values %{ $CONN->{container}{0} };
		1302
		1303	# we basically have to use the same sorting as everybody else
		1304	@items = sort { $a->{type} <=> $b->{type} } @items;
		1305
		1306	for my $item (reverse @items) {
		1307	my $desc = $item->{nrof} < 2
		1308	? $item->{name}
		1309	: "$item->{nrof} $item->{name_pl}";
		1310	# todo: animation widget, face widget, weight(?) etc.
		1311	$FLOORBOX->add (my $hbox = new CFClient::UI::HBox
		1312	tooltip => (CFClient::UI::Label->escape ($desc)
		1313	. "\n<small>leftclick - pick up\nmiddle click - apply\nrightclick - menu</small>"),
		1314	can_hover => 1,
		1315	can_events => 1,
		1316	connect_button_down => sub {
		1317	my ($self, $ev, $x, $y) = @_;
		1318
		1319	# todo: maybe put examine on 1? but should just be a tooltip :(
		1320	if ($ev->{button} == 1) {
		1321	$CONN->send ("move $CONN->{player}{tag} $item->{tag} 0");
		1322	} elsif ($ev->{button} == 2) {
		1323	$CONN->send ("apply $item->{tag}");
		1324	} elsif ($ev->{button} == 3) {
		1325	# examine, lock, mark, maybe other things
		1326	warn "MENU not implemented yet\n";
		1327	}
		1328
		1329	1
		1330	},
		1331	);
		1332
		1333	$hbox->add (new CFClient::UI::Face
		1334	can_events => 0,
		1335	face => $item->{face},
		1336	anim => $item->{anim},
		1337	animspeed => $item->{animspeed},
		1338	);
		1339
		1340	$hbox->add (new CFClient::UI::Label
		1341	can_events => 0,
		1342	text => $desc,
		1343	);
		1344	}
		1345	});
157	refresh;	1346	refresh;
158	}	1347	}
159		1348
160	sub conn::face_find {	1349	sub conn::container_add {
		1350	my ($self, $id, $items) = @_;
		1351
		1352	update_floorbox if $id == 0;
		1353	# $self-<{player}{tag} => player inv
		1354	#use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
		1355	}
		1356
		1357	sub conn::container_clear {
		1358	my ($self, $id) = @_;
		1359
		1360	update_floorbox if $id == 0;
		1361	# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
		1362	}
		1363
		1364	sub conn::item_delete {
		1365	my ($self, @items) = @_;
		1366
		1367	for (@items) {
		1368	update_floorbox if $_->{container} == 0;
		1369	}
		1370	}
		1371
		1372	sub conn::item_update {
161	my ($self, $face) = @_;	1373	my ($self, $item) = @_;
162		1374
163	$FACECACHE->{"$face->{chksum},$face->{name}"}	1375	update_floorbox if $item->{container} == 0;
164	}	1376	}
165		1377
166	sub conn::face_update {	1378	%SDL_CB = (
167	my ($self, $face) = @_;	1379	CFClient::SDL_QUIT => sub {
168		1380	Event::unloop -1;
169	$FACECACHE->{"$face->{chksum},$face->{name}"} = $face->{image};	1381	},
170		1382	CFClient::SDL_VIDEORESIZE => sub {
171	$face->{texture} = new_from_image Crossfire::Client::Texture delete $face->{image};	1383	},
172	}	1384	CFClient::SDL_VIDEOEXPOSE => \&refresh,
173		1385	CFClient::SDL_ACTIVEEVENT => sub {
174	sub gtk_add_cfg_field {	1386	# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
175	my ($tbl, $cfg, $klbl, $key, $value) = @_;	1387	},
176	my $i = $cfg->{_i}++;	1388	CFClient::SDL_KEYDOWN => sub {
177	$tbl->attach_defaults (my $lbl = Gtk2::Label->new ($klbl), 0, 1, $i, $i + 1);	1389	if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
178	$tbl->attach_defaults (my $ent = Gtk2::Entry->new, 1, 2, $i, $i + 1);	1390	# alt-enter
179	if ($key eq 'password') {	1391	video_shutdown;
180	$ent->set_invisible_char ("*");	1392	$CFG->{fullscreen} = !$CFG->{fullscreen};
181	$ent->set (visibility => 0)	1393	video_init;
182	}	1394	} else {
183	$ent->set_text ($value);	1395	CFClient::UI::feed_sdl_key_down_event ($_[0]);
184	$ent->signal_connect (changed => sub {
185	my ($ent) = @_;
186	$cfg->{$key} = $ent->get_text;
187	});	1396	}
188	}	1397	},
189		1398	CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
190	sub run_config_dialog {	1399	CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
191	my (%events) = @_;	1400	CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
192		1401	CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
193	my $w = Gtk2::Window->new;	1402	CFClient::SDL_USEREVENT => \&audio_music_finished,
194		1403	);
195	my @cfg = (
196	[qw/Host host/],
197	[qw/Port port/],
198	[qw/Username user/],
199	[qw/Password password/],
200	);
201
202	my $cfg = {};
203
204	my $a = SDL::ListModes (0, SDL_FULLSCREEN|SDL_HWSURFACE);
205	my @modes = map { [SDL::RectW ($_), SDL::RectH ($_)] } @$a;
206
207	$w->add (my $vb = Gtk2::VBox->new);
208	$vb->pack_start (my $t = Gtk2::Table->new (2, scalar @cfg), 0, 0, 0);
209	my $selmode = $::CFG->{width} . 'x' . $::CFG->{height};
210	$t->attach_defaults (Gtk2::Label->new ("Modes"), 0, 1, 0, 1);
211	$t->attach_defaults (my $cb = Gtk2::ComboBox->new_text, 1, 2, 0, 1);
212	my $i = 0;
213	my $act = 0;
214	for (map { "$_->[0]x$_->[1]" } reverse @modes) {
215	if ($_ eq $selmode) { $act = $i }
216	$cb->append_text ($_);
217	$i++;
218	}
219	$cb->set_active ($act);
220	$cb->signal_connect (changed => sub {
221	my ($cb) = @_;
222	my $txt = $cb->get_active_text;
223	if ($txt =~ m/(\d+)x(\d+)/) {
224	$::CFG->{width} = $1;
225	$::CFG->{height} = $2;
226	}
227	});
228
229	$cfg->{_i} = 1;
230	for (@cfg) {
231	gtk_add_cfg_field ($t, $cfg, $_->[0], $_->[1], $::CFG->{$_->[1]});
232	}
233
234	$vb->pack_start (my $hb = Gtk2::HBox->new, 0, 0, 0);
235	$hb->pack_start (my $cb = Gtk2::Button->new ("save"), 1, 1, 5);
236	$cb->signal_connect (clicked => sub {
237	for (keys %$cfg) {
238	$::CFG->{$_} = $cfg->{$_}
239	if $_ ne '_i';
240	}
241	Crossfire::Client::write_cfg "$Crossfire::VARDIR/pclientrc";
242	});
243	$hb->pack_start (my $cb = Gtk2::Button->new ("login"), 1, 1, 5);
244	$cb->signal_connect (clicked => sub {
245	for (keys %$cfg) {
246	$::CFG->{$_} = $cfg->{$_}
247	if $_ ne '_i';
248	}
249	my $cb = $events{login} || sub {};
250	$cb->($::CFG->{user}, $::CFG->{password});
251	});
252	$hb->pack_start (my $cb = Gtk2::Button->new ("logout"), 1, 1, 5);
253	$cb->signal_connect (clicked => sub {
254	my $cb = $events{login} || sub {};
255	$cb->();
256	});
257	$hb->pack_start (my $cb = Gtk2::Button->new ("quit"), 1, 1, 5);
258	$cb->signal_connect (clicked => sub { $w->destroy });
259
260	$w->show_all;
261
262	$w->signal_connect (destroy => sub { Gtk2->main_quit });
263	}
264
265		1404
266	#############################################################################	1405	#############################################################################
267		1406
268	SDL::Init SDL_INIT_EVERYTHING;	1407	$SIG{INT} = $SIG{TERM} = sub { exit };
269		1408
270	my $mapwidget = Crossfire::Client::Widget::MapWidget->new;	1409	$TILECACHE = CFClient::db_table "tilecache";
		1410	$FACEMAP = CFClient::db_table "facemap";
271		1411
272	$mapwidget->activate;
273	$mapwidget->focus_in;
274
275	Crossfire::Client::read_cfg "$Crossfire::VARDIR/pclientrc";	1412	CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
276		1413
277	$CFG ||= {	1414	my %DEF_CFG = (
		1415	sdl_mode => 0,
278	width => 640,	1416	width => 640,
279	height => 480,	1417	height => 480,
280	fullscreen => 0,	1418	fullscreen => 0,
		1419	fast => 0,
		1420	map_scale => 0.5,
		1421	fow_enable => 1,
		1422	fow_intensity => 0.45,
		1423	fow_smooth => 0,
		1424	gui_fontsize => 1,
		1425	log_fontsize => 1,
		1426	gauge_fontsize => 1,
		1427	gauge_size => 0.35,
		1428	stat_fontsize => 1,
		1429	mapsize => 100,
281	host => "crossfire.schmorp.de",	1430	host => "crossfire.schmorp.de",
282	port => 13327,	1431	say_command => 'say',
283	};	1432	audio_enable => 1,
		1433	bgm_enable => 1,
		1434	bgm_volume => 0.25,
		1435	);
284		1436
285	$FACECACHE = eval { Crossfire::load_ref "$Crossfire::VARDIR/pclient.faces" } || {};	1437	while (my ($k, $v) = each %DEF_CFG) {
		1438	$CFG->{$k} = $v unless exists $CFG->{$k};
		1439	}
286		1440
287	SDL::TTFInit;	1441	sdl_init;
288		1442
289	$UIFONT = SDL::TTFOpenFont Crossfire::Client::find_rcfile "uifont.ttf", 24	1443	@SDL_MODES = reverse
290	or die "TTFOpenFont: $!";	1444	grep $_->[0] >= 640 && $_->[1] >= 480,
		1445	CFClient::SDL_ListModes;
291		1446
292	run_config_dialog	1447	@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
293	login => sub { start_game },
294	logout => sub { stop_game };
295		1448
296	main Gtk2;	1449	$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
297		1450
298	Crossfire::save_ref $FACECACHE, "$Crossfire::VARDIR/pclient.faces";	1451	{
		1452	my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
		1453	DejaVuSans.ttf
		1454	DejaVuSansMono.ttf
		1455	DejaVuSans-Bold.ttf
		1456	DejaVuSansMono-Bold.ttf
		1457	DejaVuSans-Oblique.ttf
		1458	DejaVuSansMono-Oblique.ttf
		1459	DejaVuSans-BoldOblique.ttf
		1460	DejaVuSansMono-BoldOblique.ttf
		1461	);
		1462
		1463	CFClient::add_font $_ for @fonts;
		1464
		1465	$FONT_PROP = new_from_file CFClient::Font $fonts[0];
		1466	$FONT_FIXED = new_from_file CFClient::Font $fonts[1];
		1467
		1468	$FONT_PROP->make_default;
		1469	}
		1470
		1471	video_init;
		1472	audio_init;
		1473
		1474	Event::loop;
		1475
		1476	END { CFClient::SDL_Quit }
		1477
		1478	=head1 pclient - Crossfire+ and Crossfire game client
		1479
		1480	Pclient is a Crossfire+ and Crossfire game client.
		1481
		1482	=head2 Features
		1483
		1484	=over 4
		1485
		1486	=item Fullscreen Map
		1487
		1488	PClient can uses a fullscreen map, which greatly enhances how much of the
		1489	game world you can see.
		1490
		1491	=item Persistent Map Cache (Crossfire+ only)
		1492
		1493	PClient can persistently cache all map data it received from the
		1494	server. This not only allows it to display an overview map, but also
		1495	ensures that once-explored areas will be available the next time you want
		1496	to explore more.
		1497
		1498	=item Hardware acceleration
		1499
		1500	Unlike most Crossfire clients, PClient take advantage of OpenGL hardware
		1501	acceleration. Most modern graphics cards have difficulties with 2D
		1502	acceleration, while 3D graphics is accelerated well.
		1503
		1504	=item No arbitrary limits
		1505
		1506	Unlike other Crossfire clients, pclient does not suffer from arbitrary
		1507	limits (like a fixed amount of face numbers). There are still limits, but
		1508	they are not arbitrarily low :)
		1509
		1510	=back
		1511
		1512	=head1 FAQ
		1513
		1514	=over 4
		1515
		1516	=item The client is very sluggish and slow, what can I do about this?
		1517
		1518	Most likely, you don't have accelerated OpenGL support. Try to find a
		1519	newer driver, or a driver from your hardware vendor, that features OpenGL
		1520	support.
		1521
		1522	If this is not an option, the following Setup options reduce the load and
		1523	will likely make the client playable with sofwtare rendering (it will
		1524	still be slow, though):
		1525
		1526	=over 4
		1527
		1528	=item B<Video Mode> should be set as low as possible (e.g. 640x480)
		1529
		1530	=item Enable B<Fast & Ugly> mode
		1531
		1532	=item Disable B<Fog of War>
		1533
		1534	=item Increase B<Map Scale>
		1535
		1536	=back
		1537
		1538	=back
		1539
		1540	=head1 AUTHOR
		1541
		1542	Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
		1543
		1544
		1545

Diff Legend

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