[ViewVC] Diff of: cvs/deliantra/Deliantra-Client/bin/pclient

Comparing deliantra/Deliantra-Client/bin/pclient (file contents):
Revision 1.163 by root, Sun Apr 23 00:57:40 2006 UTC vs.
Revision 1.192 by root, Fri Apr 28 18:06:13 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
		6	BEGIN {
		7	if (%PAR::LibCache) {
		8	@INC = grep ref, @INC; # weed out all paths except pars loader refs
		9
		10	while (my ($filename, $zip) = each %PAR::LibCache) {
		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};
5		28
6	use Time::HiRes 'time';	29	use Time::HiRes 'time';
7	use Event;	30	use Event;
8		31
9	use Crossfire;	32	use Crossfire;
12	use Compress::LZF;	35	use Compress::LZF;
13		36
14	use CFClient;	37	use CFClient;
15	use CFClient::UI;	38	use CFClient::UI;
16	use CFClient::MapWidget;	39	use CFClient::MapWidget;
		40
		41	$Event::DIED = sub {
		42	CFClient::error $_[1];
		43	};
		44
		45	#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#
17		46
18	our $VERSION = '0.1';	47	our $VERSION = '0.1';
19		48
20	my $MAX_FPS = 60;	49	my $MAX_FPS = 60;
21	my $MIN_FPS = 5; # unused as of yet	50	my $MIN_FPS = 5; # unused as of yet
…		…
37	our $WIDTH;	66	our $WIDTH;
38	our $HEIGHT;	67	our $HEIGHT;
39	our $FULLSCREEN;	68	our $FULLSCREEN;
40	our $FONTSIZE;	69	our $FONTSIZE;
41		70
		71	our $FONT_PROP;
		72	our $FONT_FIXED;
		73
42	our $MAP;	74	our $MAP;
		75	our $MAPMAP;
43	our $MAPWIDGET;	76	our $MAPWIDGET;
44	our $BUTTONBAR;	77	our $BUTTONBAR;
45	our $LOGVIEW;	78	our $LOGVIEW;
46	our $CONSOLE;	79	our $CONSOLE;
47	our $METASERVER;	80	our $METASERVER;
48		81
		82	our $FLOORBOX;
49	our $GAUGES;	83	our $GAUGES;
50	our $STATWIDS;	84	our $STATWIDS;
51		85
52	our $SDL_ACTIVE;	86	our $SDL_ACTIVE;
53	our %SDL_CB;	87	our %SDL_CB;
…		…
57	our %AUDIO_CHUNKS; # audio files	91	our %AUDIO_CHUNKS; # audio files
58		92
59	our $ALT_ENTER_MESSAGE;	93	our $ALT_ENTER_MESSAGE;
60	our $STATUS_LINE;	94	our $STATUS_LINE;
61	our $DEBUG_STATUS;	95	our $DEBUG_STATUS;
		96
		97	our $INVWIN;
		98	our $INV;
62		99
63	sub status {	100	sub status {
64	$STATUS_LINE->set_text ($_[0]);	101	$STATUS_LINE->set_text ($_[0]);
65	$STATUS_LINE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $STATUS_LINE->{h});	102	$STATUS_LINE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $STATUS_LINE->{h});
66	}	103	}
…		…
120	$mode_slider->emit (changed => $mode_slider->{range}[0]);	157	$mode_slider->emit (changed => $mode_slider->{range}[0]);
121		158
122	my $row = 1;	159	my $row = 1;
123		160
124	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");	161	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
125	$table->add (1, $row++, new CFClient::UI::CheckBox state => $CFG->{fullscreen}, connect_changed => sub {	162	$table->add (1, $row++, new CFClient::UI::CheckBox
		163	state => $CFG->{fullscreen},
		164	tooltip => "Bring the client into fullscreen mode",
		165	connect_changed => sub {
126	my ($self, $value) = @_;	166	my ($self, $value) = @_;
127	$CFG->{fullscreen} = $value;	167	$CFG->{fullscreen} = $value;
		168	}
128	});	169	);
129		170
130	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");	171	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
131	$table->add (1, $row++, new CFClient::UI::CheckBox	172	$table->add (1, $row++, new CFClient::UI::CheckBox
132	state => $CFG->{fast},	173	state => $CFG->{fast},
133	tooltip => "Lower the visual quality considerably to speed up rendering.",	174	tooltip => "Lower the visual quality considerably to speed up rendering.",
…		…
135	my ($self, $value) = @_;	176	my ($self, $value) = @_;
136	$CFG->{fast} = $value;	177	$CFG->{fast} = $value;
137	}	178	}
138	);	179	);
139		180
		181	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
		182	$table->add (1, $row++, new CFClient::UI::Slider
		183	range => [$CFG->{map_scale}, 0.25, 2, 0.05],
		184	tooltip => "Enlarge or shrink the displayed map",
		185	connect_changed => sub {
		186	my ($self, $value) = @_;
		187	$CFG->{map_scale} = 0.05 * int $value / 0.05;
		188	}
		189	);
		190
140	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");	191	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
141	$table->add (1, $row++, new CFClient::UI::CheckBox	192	$table->add (1, $row++, new CFClient::UI::CheckBox
142	state => $CFG->{fow_enable},	193	state => $CFG->{fow_enable},
143	tooltip => "Fog-of-War marks areas that cannot be seen by the player",	194	tooltip => "Fog-of-War marks areas that cannot be seen by the player",
144	connect_changed => sub {	195	connect_changed => sub {
…		…
196	$CFG->{stat_fontsize} = 0.1 * int $_[1] * 10;	247	$CFG->{stat_fontsize} = 0.1 * int $_[1] * 10;
197	&set_stats_window_fontsize;	248	&set_stats_window_fontsize;
198	}	249	}
199	);	250	);
200		251
201	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gaugesize");
202	$table->add (1, $row++, new CFClient::UI::Slider range => [$CFG->{gauge_size}, 0.2, 0.8, 0.02], connect_changed => sub {
203	$CFG->{gauge_size} = $_[1];
204	my $h = int ($HEIGHT * $CFG->{gauge_size});
205	$GAUGES->{win}->set_size ($WIDTH, $h);
206	$GAUGES->{win}->{y} = $HEIGHT - $h;
207	$GAUGES->{win}->{x} = 0;
208	$GAUGES->{win}->update;
209	});
210
211	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");	252	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
212	$table->add (1, $row++, new CFClient::UI::Slider	253	$table->add (1, $row++, new CFClient::UI::Slider
213	range => [$CFG->{gauge_size}, 0.2, 0.8, 0.02],	254	range => [$CFG->{gauge_size}, 0.2, 0.8, 0.02],
214	tooltip => "Adjust the size of the stats gauges at the bottom right",	255	tooltip => "Adjust the size of the stats gauges at the bottom right",
215	connect_changed => sub {	256	connect_changed => sub {
216	$CFG->{gauge_size} = $_[1];	257	$CFG->{gauge_size} = $_[1];
217	my $h = int ($HEIGHT * $CFG->{gauge_size});	258	my $h = int $HEIGHT * $CFG->{gauge_size};
218	$GAUGES->{win}->set_size ($WIDTH, $h);	259	$GAUGES->{win}->set_size ($WIDTH, $h);
219	$GAUGES->{win}->{y} = $HEIGHT - $h;	260	$GAUGES->{win}->move (0, $HEIGHT - $h);
220	$GAUGES->{win}->{x} = 0;
221	$GAUGES->{win}->update;
222	}	261	}
223	);	262	);
224		263
225	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");	264	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
226	$table->add (1, $row++, new CFClient::UI::Slider	265	$table->add (1, $row++, new CFClient::UI::Slider
227	range => [$CFG->{gauge_fontsize}, 0.5, 2.0, 0.1],	266	range => [$CFG->{gauge_fontsize}, 0.5, 2.0, 0.1],
		267	tooltip => "Adjusts the fontsize of the gauges at the bottom right",
228	connect_changed => sub {	268	connect_changed => sub {
229	$CFG->{gauge_fontsize} = 0.1 * int $_[1] * 10;	269	$CFG->{gauge_fontsize} = 0.1 * int $_[1] * 10;
230	&set_gauge_window_fontsize;	270	&set_gauge_window_fontsize;
231	$GAUGES->{win}->check_size;
232	$GAUGES->{win}->update;
233	}	271	}
234	);	272	);
235		273
236	$table->add (1, $row++, new CFClient::UI::Button	274	$table->add (1, $row++, new CFClient::UI::Button
237	expand => 1, align => 0, text => "Apply",	275	expand => 1, align => 0, text => "Apply",
238	tooltip => "Apply the video settings (unless they are auto-apply)",	276	tooltip => "Apply the video settings",
239	connect_activate => sub {	277	connect_activate => sub {
240	video_shutdown ();	278	video_shutdown ();
241	video_init ();	279	video_init ();
242	}	280	}
243	);	281	);
…		…
272	}	310	}
273	);	311	);
274		312
275	$table->add (1, $row++, new CFClient::UI::Button	313	$table->add (1, $row++, new CFClient::UI::Button
276	expand => 1, align => 0, text => "Apply",	314	expand => 1, align => 0, text => "Apply",
277	tooltip => "Apply the audio settings that are not auto-apply",	315	tooltip => "Apply the audio settings",
278	connect_activate => sub {	316	connect_activate => sub {
279	audio_shutdown ();	317	audio_shutdown ();
280	audio_init ();	318	audio_init ();
281	}	319	}
282	);	320	);
283		321
		322	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Communication cmd");
		323	$table->add (1, $row++, my $saycmd = new CFClient::UI::Entry
		324	text => $CFG->{say_command},
		325	tooltip => "This is the command that will be used if you write a line in the message window entry. "
		326	."Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
		327	."But you could also set it to 'tell <playername>' to only chat with that user.",
		328	connect_changed => sub {
		329	my ($self, $value) = @_;
		330	$CFG->{say_command} = $value;
		331	}
		332	);
		333
284	$dialog	334	$dialog
285	}	335	}
286		336
287	sub set_stats_window_fontsize {	337	sub set_stats_window_fontsize {
288	for (values %{$STATWIDS}) {	338	for (values %{$STATWIDS}) {
…		…
292		342
293	sub set_gauge_window_fontsize {	343	sub set_gauge_window_fontsize {
294	for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {	344	for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {
295	$_->set_fontsize ($::CFG->{gauge_fontsize});	345	$_->set_fontsize ($::CFG->{gauge_fontsize});
296	}	346	}
		347
		348	# local $GAUGES->{win}{parent};#d#
		349	# use PApp::Util; open D, ">:utf8", "d"; print D PApp::Util::dumpval $GAUGES->{win}; close D;
297	}	350	}
298		351
299	sub make_gauge_window {	352	sub make_gauge_window {
300	my $gh = int ($HEIGHT * $CFG->{gauge_size});	353	my $gh = int ($HEIGHT * $CFG->{gauge_size});
301	# my $gw = int ($WIDTH * $CFG->{gauge_w_size});	354	# my $gw = int ($WIDTH * $CFG->{gauge_w_size});
302		355
303	my $win = new CFClient::UI::Frame (	356	my $win = new CFClient::UI::Frame (
304	y => $HEIGHT - $gh, x => 0, req_w => $WIDTH, req_h => $gh	357	y => $HEIGHT - $gh, x => 0, user_w => $WIDTH, user_h => $gh
305	);	358	);
306	$win->add (my $vb = new CFClient::UI::VBox);	359	$win->add (my $hbox = new CFClient::UI::HBox
307		360	children => [
308	$vb->add (my $hbg = new CFClient::UI::HBox expand => 1);	361	(new CFClient::UI::HBox expand => 1),
		362	($FLOORBOX = new CFClient::UI::VBox),
		363	(my $vbox = new CFClient::UI::VBox),
		364	],
		365	);
309		366
310		367	$vbox->add (new CFClient::UI::HBox
		368	expand => 1,
		369	children => [
311	$hbg->add (new CFClient::UI::Empty expand => 1);	370	(new CFClient::UI::Empty expand => 1),
312	$hbg->add (my $hb = new CFClient::UI::HBox);	371	(my $hb = new CFClient::UI::HBox),
		372	],
		373	);
		374
313	$hb->add (my $hg = new CFClient::UI::Gauge type => 'hp');	375	$hb->add (my $hg = new CFClient::UI::Gauge type => 'hp',
		376	tooltip => "Health points. Measures of how much damage you can take before dying. Hit points are determined from your level and are influenced by the value of your Con. Hp value may range between 1 to beyond 500 and higher values indicate a greater ability to withstand punishment.");
314	$hb->add (my $mg = new CFClient::UI::Gauge type => 'mana');	377	$hb->add (my $mg = new CFClient::UI::Gauge type => 'mana',
		378	tooltip => "Spell points. Measures of how much \"fuel\" you have for casting spells and incantations. Mana is calculated from your level and your Pow. Mana values can range between 1 to beyond 500 (glowing crystals can increase the current spell points beyond your normal maximum). Higher values indicate greater amounts of mana.");
315	$hb->add (my $gg = new CFClient::UI::Gauge type => 'grace');	379	$hb->add (my $gg = new CFClient::UI::Gauge type => 'grace',
		380	tooltip => "Grace points - how favored you are by your god. In game terms, how much divine magic you can cast. Your level, Wis and Pow effect what the value of grace is. Prayong on an altar of your god can increase this value beyond your normal maximum. Grace can take on large positive and negative values. Positive values indicate favor by the gods.");
316	$hb->add (my $fg = new CFClient::UI::Gauge type => 'food');	381	$hb->add (my $fg = new CFClient::UI::Gauge type => 'food',
		382	tooltip => "Food. Ranges between 0 (starving) and 999 (satiated). At a value of 0 the character begins to die. Some magic can speed up or slow down the character digestion. Healing wounds will speed up digestion too.");
317		383
318	$vb->add (my $exp = new CFClient::UI::Label valign => 0, align => 1, text => "XP:");	384	$vbox->add (my $exp = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
319	# $vb->add (my $lvl = new CFClient::UI::Label valign => 0, align => 1, text => "Lvl:");	385	tooltip => "Experience points and overall level - experience is increased as a reward for appropriate action (such as killing monsters) and may decrease as a result of a magical attack or dying. Level is directly derived from the experience value. As the level of the character increases, the character becomes able to succeed at more difficult tasks. A character's level starts at a value of 0 and may range up beyond 100.");
320	$vb->add (my $rng = new CFClient::UI::Label valign => 0, align => 1, text => "Rng:");	386	$vbox->add (my $rng = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
321		387	tooltip => "Ranged attack - how you attack when you press shift-cursor (spell, skill, weapon etc.)");
322		388
323	$GAUGES = {	389	$GAUGES = {
324	exp => $exp,# lvl => $lvl,
325	win => $win, range => $rng,	390	exp => $exp, win => $win, range => $rng,
326	food => $fg, mana => $mg, hp => $hg, grace => $gg	391	food => $fg, mana => $mg, hp => $hg, grace => $gg
327	};	392	};
		393
		394	&set_gauge_window_fontsize;
		395
328	$win	396	$win
329	}	397	}
330		398
331	sub make_stats_window {	399	sub make_stats_window {
332	my $tgw = new CFClient::UI::FancyFrame (x => $WIDTH * 2/5, y => 0, title => "Stats");	400	my $tgw = new CFClient::UI::FancyFrame x => $WIDTH * 2/5, y => 0, title => "Stats";
333		401
334	$tgw->add (my $vb = new CFClient::UI::VBox);	402	$tgw->add (new CFClient::UI::Window child => my $vb = new CFClient::UI::VBox);
335	$vb->add (my $uhb = new CFClient::UI::HBox);
336	$uhb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1);	403	$vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1);
337	$uhb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1);	404	$vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1);
338		405
339	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);	406	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
340		407
341	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);	408	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);
342		409
343	$tbl->add (0, 0, $STATWIDS->{st_str_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Str");	410	my $black = [0, 0, 0];
344	$tbl->add (0, 1, $STATWIDS->{st_dex_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Dex");
345	$tbl->add (0, 2, $STATWIDS->{st_con_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Con");
346	$tbl->add (0, 3, $STATWIDS->{st_int_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Int");
347	$tbl->add (0, 4, $STATWIDS->{st_wis_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Wis");
348	$tbl->add (0, 5, $STATWIDS->{st_pow_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Pow");
349	$tbl->add (0, 6, $STATWIDS->{st_cha_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Cha");
350		411
351	$tbl->add (1, 0, $STATWIDS->{st_str} = new CFClient::UI::Label valign => 0, align => +1, text => "");	412	for (
352	$tbl->add (1, 1, $STATWIDS->{st_dex} = new CFClient::UI::Label valign => 0, align => +1, text => "");	413	[0, 0, st_str => "Str", 30, "Physical Strength, determines damage dealt with weapons, how much you can carry, and how often you can attack"],
353	$tbl->add (1, 2, $STATWIDS->{st_con} = new CFClient::UI::Label valign => 0, align => +1, text => "");	414	[0, 1, st_dex => "Dex", 30, "Dexterity, your physical agility. Determines chance of being hit and affects armor class and speed"],
354	$tbl->add (1, 3, $STATWIDS->{st_int} = new CFClient::UI::Label valign => 0, align => +1, text => "");	415	[0, 2, st_con => "Con", 30, "Constitution, physical health and toughness. Determines how many healthpoints you can have"],
355	$tbl->add (1, 4, $STATWIDS->{st_wis} = new CFClient::UI::Label valign => 0, align => +1, text => "");	416	[0, 3, st_int => "Int", 30, "Intelligence, your ability to learn and use skills and incantations (both prayers and magic) and determines how much spell points you can have"],
356	$tbl->add (1, 5, $STATWIDS->{st_pow} = new CFClient::UI::Label valign => 0, align => +1, text => "");	417	[0, 4, st_wis => "Wis", 30, "Wisdom, the ability to learn and use divine magic (prayers). Determines how many grace points you can have"],
357	$tbl->add (1, 6, $STATWIDS->{st_cha} = new CFClient::UI::Label valign => 0, align => +1, text => "");	418	[0, 5, st_pow => "Pow", 30, "Power, your magical potential. Influences the strength of spell effects, and also how much your spell and grace points increase when leveling up"],
		419	[0, 6, st_cha => "Cha", 30, "Charisma, how well you are received by NPCs. Affects buying and selling prices in shops."],
358		420
359	$tbl->add (2, 0, $STATWIDS->{st_wc_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Wc");	421	[2, 0, st_wc => "Wc", -120, "Weapon Class, effectiveness of melee/missile attacks. Lower is more potent. Current weapon, level and Str are some things which effect the value of Wc. The value of Wc may range between 25 and -72."],
360	$tbl->add (2, 1, $STATWIDS->{st_ac_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Ac");	422	[2, 1, st_ac => "Ac", -120, "Armour Class, how protected you are from being hit by any attack. Lower values are better. Ac is based on your race and is modified by the Dex and current armour worn. For characters that cannot wear armour, Ac improves as their level increases."],
361	$tbl->add (2, 2, $STATWIDS->{st_dam_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Dam");	423	[2, 2, st_dam => "Dam", 120, "Damage, how much damage your melee/missile attack inflicts. Higher values indicate a greater amount of damage will be inflicted with each attack."],
362	$tbl->add (2, 3, $STATWIDS->{st_arm_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Arm");	424	[2, 3, st_arm => "Arm", 120, "Armour, how much damage (from physical attacks) will be subtracted from successful hits made upon you. This value ranges between 0 to 99%. Current armour worn primarily determines Arm value."],
363	$tbl->add (2, 4, $STATWIDS->{st_spd_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Sp");	425	[2, 4, st_spd => "Spd", 10.54, "Speed, how fast you can move. The value of speed may range between nearly 0 (\"very slow\") to higher than 5 (\"lightning fast\"). Base speed is determined from the Dex and modified downward proportionally by the amount of weight carried which exceeds the Max Carry limit. The armour worn also sets the upper limit on speed."],
364	$tbl->add (2, 5, $STATWIDS->{st_wspd_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "WSp");	426	[2, 5, st_wspd => "WSp", 10.54, "Weapon Speed, how many attacks you may make per unit of time (0.120s). Higher values indicate faster attack speed. Current weapon and Dex effect the value of weapon speed."],
		427	) {
		428	my ($col, $row, $id, $label, $template, $tooltip) = @$_;
365		429
366	$tbl->add (3, 0, $STATWIDS->{st_wc} = new CFClient::UI::Label valign => 0, align => +1, text => "");	430	$tbl->add ($col , $row, $STATWIDS->{$id} = new CFClient::UI::Label
367	$tbl->add (3, 1, $STATWIDS->{st_ac} = new CFClient::UI::Label valign => 0, align => +1, text => "");	431	font => $FONT_FIXED, can_hover => 1, can_events => 1, valign => 0, align => +1, template => $template, tooltip => $tooltip);
368	$tbl->add (3, 2, $STATWIDS->{st_dam} = new CFClient::UI::Label valign => 0, align => +1, text => "");	432	$tbl->add ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFClient::UI::Label
369	$tbl->add (3, 3, $STATWIDS->{st_arm} = new CFClient::UI::Label valign => 0, align => +1, text => "");	433	font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $black, valign => 0, align => -1, text => $label, tooltip => $tooltip);
370	$tbl->add (3, 4, $STATWIDS->{st_spd} = new CFClient::UI::Label valign => 0, align => +1, text => "");	434	}
371	$tbl->add (3, 5, $STATWIDS->{st_wspd} = new CFClient::UI::Label valign => 0, align => +1, text => "");
372		435
373	$hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);	436	$hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);
374		437
375	my $row = 0;	438	my $row = 0;
376	my $col = 0;	439	my $col = 0;
377		440
		441	my %resist_names = (
		442	slow => "Slow (slows you down when you are hit by the spell. Monsters will have an opportunity to come near you faster and hit you more often.)",
		443	holyw => "Holy Word (resistance you against getting the fear when someone whose god doesn't like you spells the holy word on you.)",
		444	conf => "Confusion (If you are hit by confusion you will move into random directions, and likely into monsters.)",
		445	fire => "Fire (just your resistance to fire spells like burning hands, dragonbreath, meteor swarm fire, ...)",
		446	depl => "Depletion (some monsters and other effects can cause stats depletion)",
		447	magic => "Magic (resistance to magic spells like magic missile or similar)",
		448	drain => "Draining (some monsters (e.g. vampires) and other effects can steal experience)",
		449	acid => "Acid (resistance to acid, acid hurts pretty much and also corrodes your weapons)",
		450	pois => "Poison (resistance to getting poisoned)",
		451	para => "Paralysation (this resistance affects the chance you get paralysed)",
		452	deat => "Death (resistance against death spells)",
		453	phys => "Physical (this is the resistance against physical attacks, like when a monster hit you in melee combat)",
		454	blind => "Blind (blind resistance affects the chance of a successful blinding attack)",
		455	fear => "Fear (this attack will drive you away from monsters who cast this and hit you successfully, being resistant to this helps a lot when fighting those monsters)",
		456	tund => "Turn undead",
		457	elec => "Electricity (resistance againt electricity, spells like large lightning, small lightning, ...)",
		458	cold => "Cold (this is your resistance against cold spells like icestorm, snowstorm, ...)",
		459	ghit => "Ghost hit (special attack used by ghosts and ghost-like beings)",
		460	);
378	for (qw/slow holyw conf fire depl magic	461	for (qw/slow holyw conf fire depl magic
379	drain acid pois para deat phys	462	drain acid pois para deat phys
380	blind fear tund elec cold ghit/)	463	blind fear tund elec cold ghit/)
381	{	464	{
382	$tbl2->add ($col , $row,	465	$tbl2->add ($col, $row,
383	$STATWIDS->{"res_$_"} =	466	$STATWIDS->{"res_$_"} =
384	new CFClient::UI::Label text => "0", align => +1, valign => 0	467	new CFClient::UI::Label
		468	font => $FONT_FIXED,
		469	template => "-100%",
		470	align => +1,
		471	valign => 0,
		472	can_events => 1,
		473	can_hover => 1,
		474	tooltip => $resist_names{$_},
385	);	475	);
386	$tbl2->add ($col + 1, $row, new CFClient::UI::Image image => "ui/resist/resist_$_.png");	476	$tbl2->add ($col + 1, $row, new CFClient::UI::Image
		477	font => $FONT_FIXED,
		478	can_hover => 1,
		479	can_events => 1,
		480	image => "ui/resist/resist_$_.png",
		481	tooltip => $resist_names{$_},
		482	);
387		483
388	$row++;	484	$row++;
389	if ($row % 6 == 0) {	485	if ($row % 6 == 0) {
390	$col += 2;	486	$col += 2;
391	$row = 0;	487	$row = 0;
…		…
396	update_stats_window ({});	492	update_stats_window ({});
397		493
398	$tgw	494	$tgw
399	}	495	}
400		496
		497	sub formsep {
		498	reverse join ",", grep length, split /(...)/, reverse $_[0] * 1
		499	}
		500
401	sub update_stats_window {	501	sub update_stats_window {
402	my ($stats) = @_;	502	my ($stats) = @_;
403		503
404	# i love text protocols!!!	504	# i love text protocols!!!
405	my $hp = $stats->{1} * 1;	505	my $hp = $stats->{Crossfire::Protocol::CS_STAT_HP} * 1;
406	my $hp_m = $stats->{2} * 1;	506	my $hp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXHP} * 1;
407	my $sp = $stats->{3} * 1;	507	my $sp = $stats->{Crossfire::Protocol::CS_STAT_SP} * 1;
408	my $sp_m = $stats->{4} * 1;	508	my $sp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXSP} * 1;
409	my $fo = $stats->{18} * 1;	509	my $fo = $stats->{Crossfire::Protocol::CS_STAT_FOOD} * 1;
410	my $fo_m = 999;	510	my $fo_m = 999;
411	my $gr = $stats->{23} * 1;	511	my $gr = $stats->{Crossfire::Protocol::CS_STAT_GRACE} * 1;
412	my $gr_m = $stats->{24} * 1;	512	my $gr_m = $stats->{Crossfire::Protocol::CS_STAT_MAXGRACE} * 1;
413		513
414	$GAUGES->{hp} ->set_value ($hp, $hp_m);	514	$GAUGES->{hp} ->set_value ($hp, $hp_m);
415	$GAUGES->{mana} ->set_value ($sp, $sp_m);	515	$GAUGES->{mana} ->set_value ($sp, $sp_m);
416	$GAUGES->{food} ->set_value ($fo, $fo_m);	516	$GAUGES->{food} ->set_value ($fo, $fo_m);
417	$GAUGES->{grace} ->set_value ($gr, $gr_m);	517	$GAUGES->{grace} ->set_value ($gr, $gr_m);
418	$GAUGES->{exp} ->set_text ("XP: " . ($stats->{11} \|\| $stats->{28}) * 1	518	$GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::CS_STAT_EXP64})
419	." LVL: " . $stats->{12} * 1);	519	. " (lvl " . ($stats->{Crossfire::Protocol::CS_STAT_LEVEL} * 1) . ")");
420	my $rng = $stats->{20};	520	my $rng = $stats->{Crossfire::Protocol::CS_STAT_RANGE};
421	$rng =~ s/^Range: //; # thank you so much dear server	521	$rng =~ s/^Range: //; # thank you so much dear server
422	$GAUGES->{range} ->set_text ("Rng: " . $rng);	522	$GAUGES->{range} ->set_text ("Rng: " . $rng);
423	# $GAUGES->{lvl} ->set_text ("LVL: " . $stats->{12});	523	my $title = $stats->{Crossfire::Protocol::CS_STAT_TITLE};
		524	$title =~ s/^Player: //;
424	$STATWIDS->{title} ->set_text ("Title: " . $stats->{21});	525	$STATWIDS->{title} ->set_text ("Title: " . $title);
425		526
426	if (0) { # this code can vanish, just wanted to preserver it for a checkin
427	$STATWIDS->{st_str} ->set_text (sprintf "S%d", $stats->{5});
428	$STATWIDS->{st_dex} ->set_text (sprintf "D%d", $stats->{8});
429	$STATWIDS->{st_con} ->set_text (sprintf "Co%d", $stats->{9});
430	$STATWIDS->{st_int} ->set_text (sprintf "I%d", $stats->{6});
431	$STATWIDS->{st_wis} ->set_text (sprintf "W%d", $stats->{7});
432	$STATWIDS->{st_pow} ->set_text (sprintf "P%d", $stats->{22});
433	$STATWIDS->{st_cha} ->set_text (sprintf "Ch%d", $stats->{10});
434	$STATWIDS->{st_wc} ->set_text (sprintf "Wc%d", $stats->{13});
435	$STATWIDS->{st_ac} ->set_text (sprintf "Ac%d", $stats->{14});
436	$STATWIDS->{st_dam} ->set_text (sprintf "Dam%d", $stats->{15});
437	$STATWIDS->{st_arm} ->set_text (sprintf "Arm%d", $stats->{16});
438	$STATWIDS->{st_spd} ->set_text (sprintf "Sp%.1f", $stats->{17});
439	$STATWIDS->{st_wspd}->set_text (sprintf "WSp%.1f", $stats->{19});
440	} else {
441	$STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});	527	$STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});
442	$STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});	528	$STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});
443	$STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9});	529	$STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9});
444	$STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6});	530	$STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6});
445	$STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7});	531	$STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7});
446	$STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22});	532	$STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22});
447	$STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});	533	$STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});
448	$STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13});	534	$STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13});
449	$STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14});	535	$STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14});
450	$STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});	536	$STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});
451	$STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});	537	$STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});
452	$STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{17});	538	$STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_SPEED});
453	$STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{19});	539	$STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_WEAP_SP});
454	}
455		540
456	my %tbl = (	541	my %tbl = (
457	phys => 100,	542	phys => 100,
458	magic => 101,	543	magic => 101,
459	fire => 102,	544	fire => 102,
…		…
466	pois => 109,	551	pois => 109,
467	slow => 110,	552	slow => 110,
468	para => 111,	553	para => 111,
469	tund => 112,	554	tund => 112,
470	fear => 113,	555	fear => 113,
		556	depl => 113,
471	deat => 115,	557	deat => 115,
472	holyw => 116,	558	holyw => 116,
473	blind => 117	559	blind => 117
474	);	560	);
475		561
…		…
487	$vbox->add ($dialog->{table} = new CFClient::UI::Table);	573	$vbox->add ($dialog->{table} = new CFClient::UI::Table);
488		574
489	$dialog	575	$dialog
490	}	576	}
491		577
		578	my $METASERVER_ATIME;
		579
492	sub update_metaserver {	580	sub update_metaserver {
493	my ($HOST) = @_;	581	my ($HOST) = @_;
494		582
495	status "fetching metaserver list...";	583	return if $METASERVER_ATIME > time;
		584	$METASERVER_ATIME = time + 60;
		585
		586	my $table = $METASERVER->{table};
		587	$table->clear;
		588	$table->add (0, 0, my $label = new CFClient::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
496		589
497	my $buf;	590	my $buf;
498		591
499	my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;	592	my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;
		593
		594	unless ($fh) {
		595	$label->set_text ("unable to contact metaserver: $!");
		596	return;
		597	}
500		598
501	Event->io (fd => $fh, poll => 'r', cb => sub {	599	Event->io (fd => $fh, poll => 'r', cb => sub {
502	my $res = sysread $fh, $buf, 8192, length $buf;	600	my $res = sysread $fh, $buf, 8192, length $buf;
503		601
504	if (!defined $res) {	602	if (!defined $res) {
505	$_[0]->w->cancel;	603	$_[0]->w->cancel;
506	status "metaserver: $!";	604	$label->set_text ("error while retrieving server list: $!");
507	} elsif ($res == 0) {	605	} elsif ($res == 0) {
508	$_[0]->w->cancel;	606	$_[0]->w->cancel;
509	status "server list retrieved";	607	status "server list retrieved";
510		608
511	my $table = $METASERVER->{table};	609	utf8::decode $buf if utf8::valid $buf;
512		610
513	$table->clear;	611	$table->clear;
514		612
515	my @col = qw(Use #Users Host Uptime Version Description);	613	my @col = qw(Use #Users Host Uptime Version Description);
516	$table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])	614	$table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])
…		…
540	$m = [$users, $host, $uptime, $version, $desc];	638	$m = [$users, $host, $uptime, $version, $desc];
541		639
542	$y++;	640	$y++;
543		641
544	$table->add (0, $y, new CFClient::UI::VBox children => [	642	$table->add (0, $y, new CFClient::UI::VBox children => [
545	(new CFClient::UI::Button text => " ", connect_activate => sub {	643	(new CFClient::UI::Button text => "Use", connect_activate => sub {
546	$HOST->set_text ($CFG->{host} = $host);	644	$HOST->set_text ($CFG->{host} = $host);
547	}),	645	}),
548	(new CFClient::UI::Empty expand => 1),	646	(new CFClient::UI::Empty expand => 1),
549	]);	647	]);
550		648
…		…
564	$table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");	662	$table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
565		663
566	{	664	{
567	$table->add (1, 2, my $vbox = new CFClient::UI::VBox);	665	$table->add (1, 2, my $vbox = new CFClient::UI::VBox);
568		666
569	$vbox->add (my $HOST = new CFClient::UI::Entry expand => 1, text => $CFG->{host}, connect_changed => sub {	667	$vbox->add (
		668	my $HOST = new CFClient::UI::Entry
		669	expand => 1,
		670	text => $CFG->{host},
		671	tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
		672	connect_changed => sub {
		673	my ($self, $value) = @_;
		674	$CFG->{host} = $value;
		675	}
		676	);
		677
		678	$METASERVER = metaserver_dialog;
		679
		680	$vbox->add (new CFClient::UI::Flopper
		681	expand => 1,
		682	text => "Metaserver",
		683	other => $METASERVER,
		684	tooltip => "Show a list of avaible crossfire servers",
		685	connect_open => sub {
		686	update_metaserver $HOST;
		687	}
		688	);
		689	}
		690
		691	$table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
		692	$table->add (1, 4, new CFClient::UI::Entry
		693	text => $CFG->{user},
		694	tooltip => "The name of your character on the server",
		695	connect_changed => sub {
570	my ($self, $value) = @_;	696	my ($self, $value) = @_;
571	$CFG->{host} = $value;
572	});
573
574	$METASERVER = metaserver_dialog;
575
576	$vbox->add (new CFClient::UI::Flopper expand => 1, text => "Metaserver", other => $METASERVER, connect_open => sub {
577	update_metaserver $HOST;
578	});
579	}
580
581	$table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
582	$table->add (1, 4, new CFClient::UI::Entry text => $CFG->{user}, connect_changed => sub {
583	my ($self, $value) = @_;
584	$CFG->{user} = $value;	697	$CFG->{user} = $value;
		698	}
585	});	699	);
586		700
587	$table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");	701	$table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
588	$table->add (1, 5, new CFClient::UI::Entry text => $CFG->{password}, hidden => 1, connect_changed => sub {	702	$table->add (1, 5, new CFClient::UI::Entry
		703	text => $CFG->{password},
		704	hidden => 1,
		705	tooltip => "The password for your character",
		706	connect_changed => sub {
589	my ($self, $value) = @_;	707	my ($self, $value) = @_;
590	$CFG->{password} = $value;	708	$CFG->{password} = $value;
		709	}
591	});	710	);
592
593	$table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "Def. say cmd");
594	$table->add (1, 6, my $saycmd = new CFClient::UI::Entry text => $CFG->{say_command}, connect_changed => sub {
595	my ($self, $value) = @_;
596	$CFG->{say_command} = $value;
597	});
598		711
599	$table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");	712	$table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
600	$table->add (1, 7, new CFClient::UI::Slider	713	$table->add (1, 7, new CFClient::UI::Slider
601	req_w => 100,	714	req_w => 100,
602	range => [$CFG->{mapsize}, 10, 100 + 1, 1],	715	range => [$CFG->{mapsize}, 10, 100 + 1, 1],
		716	tooltip => "This is the size of the portion of the map update the server sends you. "
		717	."If you set this to a high value you will be able to see further for example.",
603	connect_changed => sub {	718	connect_changed => sub {
604	my ($self, $value) = @_;	719	my ($self, $value) = @_;
605		720
606	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;	721	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;
607	},	722	},
…		…
615	}	730	}
616		731
617	sub message_window {	732	sub message_window {
618	my $window = new CFClient::UI::FancyFrame	733	my $window = new CFClient::UI::FancyFrame
619	title => "Messages",	734	title => "Messages",
620	border_bg => [1, 1, 1, 0.5],	735	border_bg => [1, 1, 1, 1],
621	bg => [0.3, 0.3, 0.3, 0.8],	736	bg => [0, 0, 0, 0.5],
622	user_w => int $::WIDTH / 3,	737	user_w => int $::WIDTH / 3,
623	user_h => int $::HEIGHT / 5,	738	user_h => int $::HEIGHT / 5,
624	child => (my $vbox = new CFClient::UI::VBox);	739	child => (my $vbox = new CFClient::UI::VBox);
625		740
626	$vbox->add ($LOGVIEW = new CFClient::UI::TextView	741	$vbox->add ($LOGVIEW = new CFClient::UI::TextView
627	expand => 1,	742	expand => 1,
		743	font => $FONT_FIXED,
628	fontsize => $::CFG->{log_fontsize},	744	fontsize => $::CFG->{log_fontsize},
629	);	745	);
630		746
631	$vbox->add (my $input = new CFClient::UI::Entry	747	$vbox->add (my $input = new CFClient::UI::Entry
632	connect_focus_in => sub {	748	connect_focus_in => sub {
…		…
665	};	781	};
666		782
667	$window	783	$window
668	}	784	}
669		785
		786	sub make_inventory_window {
		787	my $invwin = new CFClient::UI::FancyFrame user_w => 300, user_h => 300, title => "Inventory";
		788	$invwin->add (my $hb = new CFClient::UI::HBox);
		789	$hb->add ($INV = new CFClient::UI::Inventory expand => 1);
		790	$hb->add (my $rng = new CFClient::UI::Slider vertical => 1);
		791	$INV->set_range ($rng);
		792	$invwin
		793	}
		794
670	sub sdl_init {	795	sub sdl_init {
671	CFClient::SDL_Init	796	CFClient::SDL_Init
672	and die "SDL::Init failed!\n";	797	and die "SDL::Init failed!\n";
673	}	798	}
674		799
…		…
705	fontsize => 0.8,	830	fontsize => 0.8,
706	markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode";	831	markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode";
707	$ALT_ENTER_MESSAGE->show;	832	$ALT_ENTER_MESSAGE->show;
708	$ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h});	833	$ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h});
709		834
710	$CFClient::UI::ROOT->add ($MAPWIDGET = new CFClient::MapWidget);	835	CFClient::UI::FancyFrame->new (
711	$MAPWIDGET->focus_in;	836	border_bg => [1, 1, 1, 192/255],
		837	bg => [1, 1, 1, 0],
		838	child => ($MAPMAP = new CFClient::MapWidget::MapMap),
		839	)->show;
		840
		841	$MAPWIDGET = new CFClient::MapWidget;
712	$MAPWIDGET->connect (activate_console => sub {	842	$MAPWIDGET->connect (activate_console => sub {
713	my ($mapwidget, $preset) = @_;	843	my ($mapwidget, $preset) = @_;
714		844
715	if ($CONSOLE) {	845	if ($CONSOLE) {
716	$CONSOLE->{input}->{auto_activated} = 1;	846	$CONSOLE->{input}->{auto_activated} = 1;
…		…
719	if ($preset && $CONSOLE->{input}->get_text eq '') {	849	if ($preset && $CONSOLE->{input}->get_text eq '') {
720	$CONSOLE->{input}->set_text ($preset);	850	$CONSOLE->{input}->set_text ($preset);
721	}	851	}
722	}	852	}
723	});	853	});
		854	$MAPWIDGET->show;
		855	$MAPWIDGET->focus_in;
724		856
725	$CFClient::UI::ROOT->add ($BUTTONBAR = new CFClient::UI::HBox);	857	$BUTTONBAR = new CFClient::UI::HBox;
726		858
727	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup);	859	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup);
728	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup);	860	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup);
729	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);	861	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);
		862
		863	make_gauge_window->show; # 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
		864
		865	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window);
		866	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => make_inventory_window);
730		867
731	$BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {	868	$BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {
732	CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";	869	CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
733	status "Configuration Saved";	870	status "Configuration Saved";
734	});	871	});
735		872
736	$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	873	$BUTTONBAR->show;
737	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window);
738		874
739	$BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup	875	$BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
740
741
742	}	876	}
743		877
744	sub video_shutdown {	878	sub video_shutdown {
745	$CFClient::UI::ROOT->{children} = [];	879	$CFClient::UI::ROOT->{children} = [];
		880	undef $CFClient::UI::GRAB;
		881	undef $CFClient::UI::HOVER;
746	undef $SDL_ACTIVE;	882	undef $SDL_ACTIVE;
747	}	883	}
748		884
749	my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#	885	my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
750	my $bgmusic;#TODO#hack#d#	886	my $bgmusic;#TODO#hack#d#
…		…
924	# at worst.	1060	# at worst.
925	sub conn::flood_fill {	1061	sub conn::flood_fill {
926	my ($self, $gx, $gy, $path, $hash, $flags) = @_;	1062	my ($self, $gx, $gy, $path, $hash, $flags) = @_;
927		1063
928	# the server does not allow map paths > 6	1064	# the server does not allow map paths > 6
929	return if 6 <= length $path;	1065	return if 7 <= length $path;
930		1066
931	my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};	1067	my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
932		1068
933	for (	1069	for (
934	[1, 0, -1],	1070	[1, 0, -1],
…		…
977		1113
978	$self->flush_map;	1114	$self->flush_map;
979		1115
980	my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);	1116	my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
981		1117
982	my $mapmapw = 250;	1118	my $mapmapw = $MAPMAP->{w};
983	my $mapmaph = 250;	1119	my $mapmaph = $MAPMAP->{h};
984		1120
985	$self->{neigh_rect} = [	1121	$self->{neigh_rect} = [
986	$ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,	1122	$ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
987	$ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,	1123	$ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
988	];	1124	];
…		…
1031	}	1167	}
1032		1168
1033	gotid:	1169	gotid:
1034	$face->{id} = $id;	1170	$face->{id} = $id;
1035	$MAP->set_face ($facenum => $id);	1171	$MAP->set_face ($facenum => $id);
		1172	$self->{faceid}[$facenum] = $id;#d#
1036	$TILECACHE->get ($id)	1173	$TILECACHE->get ($id)
1037	}	1174	}
1038		1175
1039	sub conn::face_update {	1176	sub conn::face_update {
1040	my ($self, $facenum, $face) = @_;	1177	my ($self, $facenum, $face) = @_;
…		…
1048	my ($self, $id, $data) = @_;	1185	my ($self, $id, $data) = @_;
1049		1186
1050	$self->{texture}[$id] \|\|= do {	1187	$self->{texture}[$id] \|\|= do {
1051	my $tex =	1188	my $tex =
1052	new_from_image CFClient::Texture	1189	new_from_image CFClient::Texture
1053	$data, minify => 1;	1190	$data, minify => 1, mipmap => 1;
1054		1191
1055	$MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});	1192	$MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
1056	$MAPWIDGET->update;	1193	$MAPWIDGET->update;
1057		1194
1058	$tex	1195	$tex
…		…
1070		1207
1071	$chunk->play;	1208	$chunk->play;
1072	# warn "sound $x,$y,$soundnum,$type\n";#d#	1209	# warn "sound $x,$y,$soundnum,$type\n";#d#
1073	}	1210	}
1074		1211
		1212	my $LAST_QUERY; # server is stupid, stupid, stupid
		1213
1075	sub conn::query {	1214	sub conn::query {
1076	my ($self, $flags, $prompt) = @_;	1215	my ($self, $flags, $prompt) = @_;
1077		1216
1078	#TODO, display dialog with relevant information	1217	$prompt = $LAST_QUERY unless length $prompt;
1079	warn "<<<<QUERY:$flags:$prompt>>>\n";#d#	1218	$LAST_QUERY = $prompt;
		1219
		1220	my $dialog = new CFClient::UI::FancyFrame
		1221	title => "Query",
		1222	child => my $vbox = new CFClient::UI::VBox;
		1223
		1224	$vbox->add (new CFClient::UI::Label
		1225	max_w => $::WIDTH * 0.4,
		1226	text => $prompt);
		1227
		1228	if ($flags & Crossfire::Protocol::CS_QUERY_YESNO) {
		1229	$vbox->add (my $hbox = new CFClient::HBox);
		1230	$hbox->add (new CFClient::Button
		1231	text => "No",
		1232	connect_activate => sub {
		1233	$self->send ("reply n");
		1234	$dialog->destroy;
		1235	$MAPWIDGET->focus_in;
		1236	}
		1237	);
		1238	$hbox->add (new CFClient::Button
		1239	text => "Yes",
		1240	connect_activate => sub {
		1241	$self->send ("reply y");
		1242	$dialog->destroy;
		1243	$MAPWIDGET->focus_in;
		1244	},
		1245	);
		1246
		1247	$dialog->focus_in;
		1248
		1249	} elsif ($flags & Crossfire::Protocol::CS_QUERY_SINGLECHAR) {
		1250	$dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";
		1251	$vbox->add (my $entry = new CFClient::UI::Entry
		1252	connect_changed => sub {
		1253	$self->send ("reply $_[1]");
		1254	$dialog->destroy;
		1255	$MAPWIDGET->focus_in;
		1256	},
		1257	);
		1258
		1259	$entry->focus_in;
		1260
		1261	} else {
		1262	$dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
		1263
		1264	$vbox->add (my $entry = new CFClient::UI::Entry
		1265	$flags & Crossfire::Protocol::CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (),
		1266	connect_activate => sub {
		1267	$self->send ("reply $_[1]");
		1268	$dialog->destroy;
		1269	$MAPWIDGET->focus_in;
		1270	},
		1271	);
		1272
		1273	$entry->focus_in;
		1274	}
		1275
		1276	$dialog->show;
1080	}	1277	}
1081		1278
1082	sub conn::drawinfo {	1279	sub conn::drawinfo {
1083	my ($self, $color, $text) = @_;	1280	my ($self, $color, $text) = @_;
1084		1281
…		…
1102	}	1299	}
1103		1300
1104	sub conn::spell_add {	1301	sub conn::spell_add {
1105	my ($self, $spell) = @_;	1302	my ($self, $spell) = @_;
1106		1303
		1304	# TODO
		1305	# create a widget dynamically, using spell face (CF::Protocol downloads them)
1107	$MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message}, sub {	1306	$MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message});
1108	});
1109	$MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message}, sub {	1307	$MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message});
1110	});
1111	}	1308	}
1112		1309
1113	sub conn::spell_delete {	1310	sub conn::spell_delete {
1114	my ($self, $spell) = @_;	1311	my ($self, $spell) = @_;
1115	}	1312	}
1116		1313
1117	sub conn::addme_success {	1314	sub conn::addme_success {
1118	my ($self) = @_;	1315	my ($self) = @_;
1119		1316
1120	for my $skill (values %{$self->{skill_info}}) {	1317	for my $skill (values %{$self->{skill_info}}) {
1121	$MAPWIDGET->add_command ("ready_skill $skill", "", sub {	1318	$MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'");
		1319	$MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'");
		1320	}
		1321	}
		1322
		1323	sub update_floorbox {
		1324	$CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
		1325	$FLOORBOX->clear;
		1326	$FLOORBOX->add (new CFClient::UI::Empty expand => 1);
		1327
		1328	my @items = values %{ $CONN->{container}{0} };
		1329
		1330	# we basically have to use the same sorting as everybody else
		1331	@items = sort { $a->{type} <=> $b->{type} } @items;
		1332
		1333	for my $item (reverse @items) {
		1334	my $desc = $item->{nrof} < 2
		1335	? $item->{name}
		1336	: "$item->{nrof} $item->{name_pl}";
		1337	# todo: animation widget, face widget, weight(?) etc.
		1338	$FLOORBOX->add (my $hbox = new CFClient::UI::HBox
		1339	tooltip => (CFClient::UI::Label->escape ($desc)
		1340	. "\n<small>leftclick - pick up\nmiddle click - apply\nrightclick - menu</small>"),
		1341	can_hover => 1,
		1342	can_events => 1,
		1343	connect_button_down => sub {
		1344	my ($self, $ev, $x, $y) = @_;
		1345
		1346	# todo: maybe put examine on 1? but should just be a tooltip :(
		1347	if ($ev->{button} == 1) {
		1348	$CONN->send ("move $CONN->{player}{tag} $item->{tag} 0");
		1349	} elsif ($ev->{button} == 2) {
		1350	$CONN->send ("apply $item->{tag}");
		1351	} elsif ($ev->{button} == 3) {
		1352	CFClient::UI::Menu->new (
		1353	items => [
		1354	["examine", sub { $CONN->send ("examine $item->{tag}") }],
		1355	[
		1356	$item->{flags} & Crossfire::Protocol::F_LOCKED ? "lock" : "unlock",
		1357	sub { $CONN->send ("lock $item->{tag}") },
		1358	],
		1359	["mark", sub { $CONN->send ("mark $item->{tag}") }],
		1360	["apply", sub { $CONN->send ("apply $item->{tag}") }],
		1361	],
		1362	)->popup ($ev);
		1363	}
		1364
		1365	1
		1366	},
		1367	);
		1368
		1369	$hbox->add (new CFClient::UI::Face
		1370	can_events => 0,
		1371	face => $item->{face},
		1372	anim => $item->{anim},
		1373	animspeed => $item->{animspeed},
		1374	);
		1375
		1376	$hbox->add (new CFClient::UI::Label
		1377	can_events => 0,
		1378	text => $desc,
		1379	);
1122	});	1380	}
1123	$MAPWIDGET->add_command ("use_skill $skill", "", sub {	1381	});
		1382	refresh;
		1383	}
		1384
		1385	sub conn::container_add {
		1386	my ($self, $id, $items) = @_;
		1387
		1388	update_floorbox if $id == 0;
		1389	if ($self->{player}{tag} == $id) {
		1390	$INV->set_items ($self->{container}{$self->{player}{tag}});
		1391	}
		1392	# $self-<{player}{tag} => player inv
		1393	#use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
		1394	}
		1395
		1396	sub conn::container_clear {
		1397	my ($self, $id) = @_;
		1398
		1399	update_floorbox if $id == 0;
		1400	if ($self->{player}{tag} == $id) {
		1401	$INV->set_items ($self->{container}{$id});
		1402	}
		1403
		1404	# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
		1405	}
		1406
		1407	sub conn::item_delete {
		1408	my ($self, @items) = @_;
		1409
		1410	for (@items) {
		1411	update_floorbox if $_->{container} == 0;
		1412	if ($self->{player}{tag} == $_->{container}) {
		1413	$INV->set_items ($self->{container}{$_->{container}});
1124	});	1414	}
		1415	}
		1416	}
		1417
		1418	sub conn::item_update {
		1419	my ($self, $item) = @_;
		1420
		1421	update_floorbox if $item->{container} == 0;
		1422	if ($self->{player}{tag} == $item->{container}) {
		1423	$INV->set_items ($self->{container}{$item->{container}});
1125	}	1424	}
1126	}	1425	}
1127		1426
1128	%SDL_CB = (	1427	%SDL_CB = (
1129	CFClient::SDL_QUIT => sub {	1428	CFClient::SDL_QUIT => sub {
…		…
1165	sdl_mode => 0,	1464	sdl_mode => 0,
1166	width => 640,	1465	width => 640,
1167	height => 480,	1466	height => 480,
1168	fullscreen => 0,	1467	fullscreen => 0,
1169	fast => 0,	1468	fast => 0,
		1469	map_scale => 0.5,
1170	fow_enable => 1,	1470	fow_enable => 1,
1171	fow_intensity => 0.45,	1471	fow_intensity => 0.45,
1172	fow_smooth => 0,	1472	fow_smooth => 0,
1173	gui_fontsize => 1,	1473	gui_fontsize => 1,
1174	log_fontsize => 1,	1474	log_fontsize => 1,
…		…
1196	@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";	1496	@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
1197		1497
1198	$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;	1498	$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
1199		1499
1200	{	1500	{
1201	my @fonts = map CFClient::find_rcfile $_, qw(uifont.ttf uifontb.ttf uifonti.ttf uifontbi.ttf);	1501	my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
		1502	DejaVuSans.ttf
		1503	DejaVuSansMono.ttf
		1504	DejaVuSans-Bold.ttf
		1505	DejaVuSansMono-Bold.ttf
		1506	DejaVuSans-Oblique.ttf
		1507	DejaVuSansMono-Oblique.ttf
		1508	DejaVuSans-BoldOblique.ttf
		1509	DejaVuSansMono-BoldOblique.ttf
		1510	);
1202		1511
1203	CFClient::add_font $_ for @fonts;	1512	CFClient::add_font $_ for @fonts;
1204	CFClient::set_font $fonts[0];	1513
		1514	$FONT_PROP = new_from_file CFClient::Font $fonts[0];
		1515	$FONT_FIXED = new_from_file CFClient::Font $fonts[1];
		1516
		1517	$FONT_PROP->make_default;
1205	}	1518	}
1206		1519
1207	video_init;	1520	video_init;
1208	audio_init;	1521	audio_init;
1209		1522
1210	Event::loop;	1523	Event::loop;
1211		1524
1212	END { CFClient::SDL_Quit }	1525	END { CFClient::SDL_Quit }
1213		1526
		1527	=head1 pclient - Crossfire+ and Crossfire game client
1214		1528
		1529	Pclient is a Crossfire+ and Crossfire game client.
		1530
		1531	=head2 Features
		1532
		1533	=over 4
		1534
		1535	=item Fullscreen Map
		1536
		1537	PClient can uses a fullscreen map, which greatly enhances how much of the
		1538	game world you can see.
		1539
		1540	=item Persistent Map Cache (Crossfire+ only)
		1541
		1542	PClient can persistently cache all map data it received from the
		1543	server. This not only allows it to display an overview map, but also
		1544	ensures that once-explored areas will be available the next time you want
		1545	to explore more.
		1546
		1547	=item Hardware acceleration
		1548
		1549	Unlike most Crossfire clients, PClient take advantage of OpenGL hardware
		1550	acceleration. Most modern graphics cards have difficulties with 2D
		1551	acceleration, while 3D graphics is accelerated well.
		1552
		1553	=item No arbitrary limits
		1554
		1555	Unlike other Crossfire clients, pclient does not suffer from arbitrary
		1556	limits (like a fixed amount of face numbers). There are still limits, but
		1557	they are not arbitrarily low :)
		1558
		1559	=back
		1560
		1561	=head1 USAGE
		1562
		1563	=head2 The Map
		1564
		1565	The map is always displayed in the background, behind all other windows and UI elements.
		1566
		1567	#TODO# middle-click scrolls
		1568	#
		1569	# keys:
		1570	#
		1571	# a apply
		1572	# keypad moves, kp_5 applies ranged attack to self
		1573
		1574	Starting to type enters the I<completion mode>. In that mode, you can type
		1575	abbreviations or commands and have them executed as soon as they match a
		1576	valid command. This is best explained by a few examples:
		1577
		1578	Typing B<climb> will display a list of commands with I<climb> in their
		1579	name, such as I<ready_skill climbing> and I<use_skill climbing>.
		1580
		1581	You can abbreviate commands by typing only the first character of every
		1582	word. For example, typing I<iwor> will likely select I<invoke word of
		1583	recall>, while I<ccfo> will select I<cast create food>. Likewise, I<rscli>
		1584	will likely select I<ready_skill climbing> and I<usl> will give you
		1585	I<use_skill levitation>.
		1586
		1587	=head2 The map overview
		1588
		1589	#TODO#
		1590
		1591	=head2 The Status area in the lower right corner
		1592
		1593	#TODO#
		1594
		1595	=head2 The I<Statistics>/I>Stats> window
		1596
		1597	#TODO#
		1598
		1599	=head1 FAQ
		1600
		1601	=over 4
		1602
		1603	=item The client is very sluggish and slow, what can I do about this?
		1604
		1605	Most likely, you don't have accelerated OpenGL support. Try to find a
		1606	newer driver, or a driver from your hardware vendor, that features OpenGL
		1607	support.
		1608
		1609	If this is not an option, the following Setup options reduce the load and
		1610	will likely make the client playable with sofwtare rendering (it will
		1611	still be slow, though):
		1612
		1613	=over 4
		1614
		1615	=item B<Video Mode> should be set as low as possible (e.g. 640x480)
		1616
		1617	=item Enable B<Fast & Ugly> mode
		1618
		1619	=item Disable B<Fog of War>
		1620
		1621	=item Increase B<Map Scale>
		1622
		1623	=back
		1624
		1625	=back
		1626
		1627	=head1 AUTHOR
		1628
		1629	Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
		1630
		1631
		1632

Diff Legend

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

Comparing deliantra/Deliantra-Client/bin/pclient (file contents): Revision 1.163 by root, Sun Apr 23 00:57:40 2006 UTC vs. Revision 1.192 by root, Fri Apr 28 18:06:13 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/bin/pclient (file contents):
Revision 1.163 by root, Sun Apr 23 00:57:40 2006 UTC vs.
Revision 1.192 by root, Fri Apr 28 18:06:13 2006 UTC