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

Comparing deliantra/Deliantra-Client/bin/pclient (file contents):
Revision 1.167 by root, Sun Apr 23 05:33:24 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
		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
…		…
36	our @SDL_MODES;	65	our @SDL_MODES;
37	our $WIDTH;	66	our $WIDTH;
38	our $HEIGHT;	67	our $HEIGHT;
39	our $FULLSCREEN;	68	our $FULLSCREEN;
40	our $FONTSIZE;	69	our $FONTSIZE;
		70
		71	our $FONT_PROP;
		72	our $FONT_FIXED;
41		73
42	our $MAP;	74	our $MAP;
43	our $MAPWIDGET;	75	our $MAPWIDGET;
44	our $BUTTONBAR;	76	our $BUTTONBAR;
45	our $LOGVIEW;	77	our $LOGVIEW;
46	our $CONSOLE;	78	our $CONSOLE;
47	our $METASERVER;	79	our $METASERVER;
48		80
		81	our $FLOORBOX;
49	our $GAUGES;	82	our $GAUGES;
50	our $STATWIDS;	83	our $STATWIDS;
51		84
52	our $SDL_ACTIVE;	85	our $SDL_ACTIVE;
53	our %SDL_CB;	86	our %SDL_CB;
…		…
139	my ($self, $value) = @_;	172	my ($self, $value) = @_;
140	$CFG->{fast} = $value;	173	$CFG->{fast} = $value;
141	}	174	}
142	);	175	);
143		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
144	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");	187	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
145	$table->add (1, $row++, new CFClient::UI::CheckBox	188	$table->add (1, $row++, new CFClient::UI::CheckBox
146	state => $CFG->{fow_enable},	189	state => $CFG->{fow_enable},
147	tooltip => "Fog-of-War marks areas that cannot be seen by the player",	190	tooltip => "Fog-of-War marks areas that cannot be seen by the player",
148	connect_changed => sub {	191	connect_changed => sub {
…		…
219	range => [$CFG->{gauge_fontsize}, 0.5, 2.0, 0.1],	262	range => [$CFG->{gauge_fontsize}, 0.5, 2.0, 0.1],
220	tooltip => "Adjusts the fontsize of the gauges at the bottom right",	263	tooltip => "Adjusts the fontsize of the gauges at the bottom right",
221	connect_changed => sub {	264	connect_changed => sub {
222	$CFG->{gauge_fontsize} = 0.1 * int $_[1] * 10;	265	$CFG->{gauge_fontsize} = 0.1 * int $_[1] * 10;
223	&set_gauge_window_fontsize;	266	&set_gauge_window_fontsize;
224	#$GAUGES->{win}->check_size;
225	#$GAUGES->{win}->update;
226	}	267	}
227	);	268	);
228		269
229	$table->add (1, $row++, new CFClient::UI::Button	270	$table->add (1, $row++, new CFClient::UI::Button
230	expand => 1, align => 0, text => "Apply",	271	expand => 1, align => 0, text => "Apply",
231	tooltip => "Apply the video settings (unless they are auto-apply)",	272	tooltip => "Apply the video settings",
232	connect_activate => sub {	273	connect_activate => sub {
233	video_shutdown ();	274	video_shutdown ();
234	video_init ();	275	video_init ();
235	}	276	}
236	);	277	);
…		…
265	}	306	}
266	);	307	);
267		308
268	$table->add (1, $row++, new CFClient::UI::Button	309	$table->add (1, $row++, new CFClient::UI::Button
269	expand => 1, align => 0, text => "Apply",	310	expand => 1, align => 0, text => "Apply",
270	tooltip => "Apply the audio settings that are not auto-apply",	311	tooltip => "Apply the audio settings",
271	connect_activate => sub {	312	connect_activate => sub {
272	audio_shutdown ();	313	audio_shutdown ();
273	audio_init ();	314	audio_init ();
274	}	315	}
275	);	316	);
…		…
285		326
286	sub set_gauge_window_fontsize {	327	sub set_gauge_window_fontsize {
287	for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {	328	for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {
288	$_->set_fontsize ($::CFG->{gauge_fontsize});	329	$_->set_fontsize ($::CFG->{gauge_fontsize});
289	}	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;
290	}	334	}
291		335
292	sub make_gauge_window {	336	sub make_gauge_window {
293	my $gh = int ($HEIGHT * $CFG->{gauge_size});	337	my $gh = int ($HEIGHT * $CFG->{gauge_size});
294	# my $gw = int ($WIDTH * $CFG->{gauge_w_size});	338	# my $gw = int ($WIDTH * $CFG->{gauge_w_size});
295		339
296	my $win = new CFClient::UI::Frame (	340	my $win = new CFClient::UI::Frame (
297	y => $HEIGHT - $gh, x => 0, req_w => $WIDTH, req_h => $gh	341	y => $HEIGHT - $gh, x => 0, user_w => $WIDTH, user_h => $gh
298	);	342	);
299	$win->add (my $vb = new CFClient::UI::VBox);	343	$win->add (my $hbox = new CFClient::UI::HBox
300		344	children => [
301	$vb->add (my $hbg = new CFClient::UI::HBox expand => 1);	345	(new CFClient::UI::HBox expand => 1),
		346	($FLOORBOX = new CFClient::UI::VBox),
		347	(my $vbox = new CFClient::UI::VBox),
		348	],
		349	);
302		350
303		351	$vbox->add (new CFClient::UI::HBox
		352	expand => 1,
		353	children => [
304	$hbg->add (new CFClient::UI::Empty expand => 1);	354	(new CFClient::UI::Empty expand => 1),
305	$hbg->add (my $hb = new CFClient::UI::HBox);	355	(my $hb = new CFClient::UI::HBox),
		356	],
		357	);
		358
306	$hb->add (my $hg = new CFClient::UI::Gauge type => 'hp', tooltip => "Health points");	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");
307	$hb->add (my $mg = new CFClient::UI::Gauge type => 'mana', tooltip => "Spellpoints");	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");
308	$hb->add (my $gg = new CFClient::UI::Gauge type => 'grace', tooltip => "Grace");	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");
309	$hb->add (my $fg = new CFClient::UI::Gauge type => 'food', tooltip => "Food");	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");
310		367
311	$vb->add (my $exp = new CFClient::UI::Label valign => 0, align => 1, text => "XP: 0 LVL: 0");	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");
312	$vb->add (my $rng = new CFClient::UI::Label valign => 0, align => 1, text => "Rng:");	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.)");
313		372
314	$GAUGES = {	373	$GAUGES = {
315	exp => $exp, win => $win, range => $rng,	374	exp => $exp, win => $win, range => $rng,
316	food => $fg, mana => $mg, hp => $hg, grace => $gg	375	food => $fg, mana => $mg, hp => $hg, grace => $gg
317	};	376	};
		377
		378	&set_gauge_window_fontsize;
		379
318	$win	380	$win
319	}	381	}
320		382
321	sub make_stats_window {	383	sub make_stats_window {
322	my $tgw = new CFClient::UI::FancyFrame (x => $WIDTH * 2/5, y => 0, title => "Stats");	384	my $tgw = new CFClient::UI::FancyFrame (x => $WIDTH * 2/5, y => 0, title => "Stats");
323		385
324	$tgw->add (my $vb = new CFClient::UI::VBox);	386	$tgw->add (my $vb = new CFClient::UI::VBox);
325	$vb->add (my $uhb = new CFClient::UI::HBox);
326	$uhb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1);	387	$vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1);
327	$uhb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1);	388	$vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1);
328		389
329	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);	390	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
330		391
331	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);	392	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);
332		393
333	$tbl->add (0, 0, $STATWIDS->{st_str_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Str");	394	my $black = [0, 0, 0];
334	$tbl->add (0, 1, $STATWIDS->{st_dex_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Dex");
335	$tbl->add (0, 2, $STATWIDS->{st_con_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Con");
336	$tbl->add (0, 3, $STATWIDS->{st_int_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Int");
337	$tbl->add (0, 4, $STATWIDS->{st_wis_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Wis");
338	$tbl->add (0, 5, $STATWIDS->{st_pow_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Pow");
339	$tbl->add (0, 6, $STATWIDS->{st_cha_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Cha");
340		395
341	$tbl->add (1, 0, $STATWIDS->{st_str} = new CFClient::UI::Label valign => 0, align => +1, text => "");	396	$tbl->add (0, 0, $STATWIDS->{st_str} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
342	$tbl->add (1, 1, $STATWIDS->{st_dex} = new CFClient::UI::Label valign => 0, align => +1, text => "");	397	$tbl->add (0, 1, $STATWIDS->{st_dex} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
343	$tbl->add (1, 2, $STATWIDS->{st_con} = new CFClient::UI::Label valign => 0, align => +1, text => "");	398	$tbl->add (0, 2, $STATWIDS->{st_con} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
344	$tbl->add (1, 3, $STATWIDS->{st_int} = new CFClient::UI::Label valign => 0, align => +1, text => "");	399	$tbl->add (0, 3, $STATWIDS->{st_int} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
345	$tbl->add (1, 4, $STATWIDS->{st_wis} = new CFClient::UI::Label valign => 0, align => +1, text => "");	400	$tbl->add (0, 4, $STATWIDS->{st_wis} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
346	$tbl->add (1, 5, $STATWIDS->{st_pow} = new CFClient::UI::Label valign => 0, align => +1, text => "");	401	$tbl->add (0, 5, $STATWIDS->{st_pow} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
347	$tbl->add (1, 6, $STATWIDS->{st_cha} = new CFClient::UI::Label valign => 0, align => +1, text => "");	402	$tbl->add (0, 6, $STATWIDS->{st_cha} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
348		403
349	$tbl->add (2, 0, $STATWIDS->{st_wc_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Wc");
350	$tbl->add (2, 1, $STATWIDS->{st_ac_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Ac");
351	$tbl->add (2, 2, $STATWIDS->{st_dam_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Dam");
352	$tbl->add (2, 3, $STATWIDS->{st_arm_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Arm");
353	$tbl->add (2, 4, $STATWIDS->{st_spd_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Sp");	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");
354	$tbl->add (2, 5, $STATWIDS->{st_wspd_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "WSp");	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");
355		411
356	$tbl->add (3, 0, $STATWIDS->{st_wc} = new CFClient::UI::Label valign => 0, align => +1, text => "");	412	$tbl->add (2, 0, $STATWIDS->{st_wc} = new CFClient::UI::Label valign => 0, align => +1, template => "-120");
357	$tbl->add (3, 1, $STATWIDS->{st_ac} = new CFClient::UI::Label valign => 0, align => +1, text => "");	413	$tbl->add (2, 1, $STATWIDS->{st_ac} = new CFClient::UI::Label valign => 0, align => +1, template => "-120");
358	$tbl->add (3, 2, $STATWIDS->{st_dam} = new CFClient::UI::Label valign => 0, align => +1, text => "");	414	$tbl->add (2, 2, $STATWIDS->{st_dam} = new CFClient::UI::Label valign => 0, align => +1, template => "120");
359	$tbl->add (3, 3, $STATWIDS->{st_arm} = new CFClient::UI::Label valign => 0, align => +1, text => "");	415	$tbl->add (2, 3, $STATWIDS->{st_arm} = new CFClient::UI::Label valign => 0, align => +1, template => "120");
360	$tbl->add (3, 4, $STATWIDS->{st_spd} = new CFClient::UI::Label valign => 0, align => +1, text => "");	416	$tbl->add (2, 4, $STATWIDS->{st_spd} = new CFClient::UI::Label valign => 0, align => +1, template => "10.54");
361	$tbl->add (3, 5, $STATWIDS->{st_wspd} = new CFClient::UI::Label valign => 0, align => +1, text => "");	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");
362		425
363	$hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);	426	$hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);
364		427
365	my $row = 0;	428	my $row = 0;
366	my $col = 0;	429	my $col = 0;
…		…
389	drain acid pois para deat phys	452	drain acid pois para deat phys
390	blind fear tund elec cold ghit/)	453	blind fear tund elec cold ghit/)
391	{	454	{
392	$tbl2->add ($col, $row,	455	$tbl2->add ($col, $row,
393	$STATWIDS->{"res_$_"} =	456	$STATWIDS->{"res_$_"} =
394	new CFClient::UI::Label text => "0", align => +1, valign => 0	457	new CFClient::UI::Label
		458	template => "-100%",
		459	align => +1,
		460	valign => 0,
		461	tooltip => $resist_names{$_}
395	);	462	);
396	$tbl2->add ($col + 1, $row, new CFClient::UI::Image can_hover => 1, can_events => 1, image => "ui/resist/resist_$_.png", tooltip => $resist_names{$_});	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	);
397		469
398	$row++;	470	$row++;
399	if ($row % 6 == 0) {	471	if ($row % 6 == 0) {
400	$col += 2;	472	$col += 2;
401	$row = 0;	473	$row = 0;
…		…
406	update_stats_window ({});	478	update_stats_window ({});
407		479
408	$tgw	480	$tgw
409	}	481	}
410		482
		483	sub formsep {
		484	reverse join ",", grep length, split /(...)/, reverse $_[0] * 1
		485	}
		486
411	sub update_stats_window {	487	sub update_stats_window {
412	my ($stats) = @_;	488	my ($stats) = @_;
413		489
414	# i love text protocols!!!	490	# i love text protocols!!!
415	my $hp = $stats->{1} * 1;	491	my $hp = $stats->{Crossfire::Protocol::CS_STAT_HP} * 1;
416	my $hp_m = $stats->{2} * 1;	492	my $hp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXHP} * 1;
417	my $sp = $stats->{3} * 1;	493	my $sp = $stats->{Crossfire::Protocol::CS_STAT_SP} * 1;
418	my $sp_m = $stats->{4} * 1;	494	my $sp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXSP} * 1;
419	my $fo = $stats->{18} * 1;	495	my $fo = $stats->{Crossfire::Protocol::CS_STAT_FOOD} * 1;
420	my $fo_m = 999;	496	my $fo_m = 999;
421	my $gr = $stats->{23} * 1;	497	my $gr = $stats->{Crossfire::Protocol::CS_STAT_GRACE} * 1;
422	my $gr_m = $stats->{24} * 1;	498	my $gr_m = $stats->{Crossfire::Protocol::CS_STAT_MAXGRACE} * 1;
423		499
424	$GAUGES->{hp} ->set_value ($hp, $hp_m);	500	$GAUGES->{hp} ->set_value ($hp, $hp_m);
425	$GAUGES->{mana} ->set_value ($sp, $sp_m);	501	$GAUGES->{mana} ->set_value ($sp, $sp_m);
426	$GAUGES->{food} ->set_value ($fo, $fo_m);	502	$GAUGES->{food} ->set_value ($fo, $fo_m);
427	$GAUGES->{grace} ->set_value ($gr, $gr_m);	503	$GAUGES->{grace} ->set_value ($gr, $gr_m);
428	$GAUGES->{exp} ->set_text ("XP: " . ($stats->{11} \|\| $stats->{28}) * 1	504	$GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::CS_STAT_EXP64})
429	." LVL: " . $stats->{12} * 1);	505	. " (lvl " . ($stats->{Crossfire::Protocol::CS_STAT_LEVEL} * 1) . ")");
430	my $rng = $stats->{20};	506	my $rng = $stats->{Crossfire::Protocol::CS_STAT_RANGE};
431	$rng =~ s/^Range: //; # thank you so much dear server	507	$rng =~ s/^Range: //; # thank you so much dear server
432	$GAUGES->{range} ->set_text ("Rng: " . $rng);	508	$GAUGES->{range} ->set_text ("Rng: " . $rng);
433	my $title = $stats->{21};	509	my $title = $stats->{Crossfire::Protocol::CS_STAT_TITLE};
434	$title =~ s/^Player: //;	510	$title =~ s/^Player: //;
435	$STATWIDS->{title} ->set_text ("Title: " . $title);	511	$STATWIDS->{title} ->set_text ("Title: " . $title);
436		512
437	$STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});	513	$STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});
438	$STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});	514	$STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});
439	$STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9});	515	$STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9});
440	$STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6});	516	$STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6});
441	$STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7});	517	$STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7});
442	$STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22});	518	$STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22});
443	$STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});	519	$STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});
444	$STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13});	520	$STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13});
445	$STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14});	521	$STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14});
446	$STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});	522	$STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});
447	$STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});	523	$STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});
448	$STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{17});	524	$STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_SPEED});
449	$STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{19});	525	$STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_WEAP_SP});
450		526
451	my %tbl = (	527	my %tbl = (
452	phys => 100,	528	phys => 100,
453	magic => 101,	529	magic => 101,
454	fire => 102,	530	fire => 102,
…		…
486	}	562	}
487		563
488	sub update_metaserver {	564	sub update_metaserver {
489	my ($HOST) = @_;	565	my ($HOST) = @_;
490		566
491	status "fetching metaserver list...";	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...");
492		570
493	my $buf;	571	my $buf;
494		572
495	my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;	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	}
496		579
497	Event->io (fd => $fh, poll => 'r', cb => sub {	580	Event->io (fd => $fh, poll => 'r', cb => sub {
498	my $res = sysread $fh, $buf, 8192, length $buf;	581	my $res = sysread $fh, $buf, 8192, length $buf;
499		582
500	if (!defined $res) {	583	if (!defined $res) {
501	$_[0]->w->cancel;	584	$_[0]->w->cancel;
502	status "metaserver: $!";	585	$label->set_text ("error while retrieving server list: $!");
503	} elsif ($res == 0) {	586	} elsif ($res == 0) {
504	$_[0]->w->cancel;	587	$_[0]->w->cancel;
505	status "server list retrieved";	588	status "server list retrieved";
506		589
507	my $table = $METASERVER->{table};	590	utf8::decode $buf if utf8::valid $buf;
508		591
509	$table->clear;	592	$table->clear;
510		593
511	my @col = qw(Use #Users Host Uptime Version Description);	594	my @col = qw(Use #Users Host Uptime Version Description);
512	$table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])	595	$table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])
…		…
536	$m = [$users, $host, $uptime, $version, $desc];	619	$m = [$users, $host, $uptime, $version, $desc];
537		620
538	$y++;	621	$y++;
539		622
540	$table->add (0, $y, new CFClient::UI::VBox children => [	623	$table->add (0, $y, new CFClient::UI::VBox children => [
541	(new CFClient::UI::Button text => " ", connect_activate => sub {	624	(new CFClient::UI::Button text => "Use", connect_activate => sub {
542	$HOST->set_text ($CFG->{host} = $host);	625	$HOST->set_text ($CFG->{host} = $host);
543	}),	626	}),
544	(new CFClient::UI::Empty expand => 1),	627	(new CFClient::UI::Empty expand => 1),
545	]);	628	]);
546		629
…		…
610	$table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "Def. say cmd");	693	$table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "Def. say cmd");
611	$table->add (1, 6, my $saycmd = new CFClient::UI::Entry	694	$table->add (1, 6, my $saycmd = new CFClient::UI::Entry
612	text => $CFG->{say_command},	695	text => $CFG->{say_command},
613	tooltip => "This is the command that will be used if you write a line in the message window entry. "	696	tooltip => "This is the command that will be used if you write a line in the message window entry. "
614	."Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "	697	."Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
615	."But you could also set it to 'tell <playername>' to only chat with that user.",	698	."But you could also set it to 'tell <playername>' to only chat with that user.",
616	connect_changed => sub {	699	connect_changed => sub {
617	my ($self, $value) = @_;	700	my ($self, $value) = @_;
618	$CFG->{say_command} = $value;	701	$CFG->{say_command} = $value;
619	}	702	}
620	);	703	);
…		…
648	user_h => int $::HEIGHT / 5,	731	user_h => int $::HEIGHT / 5,
649	child => (my $vbox = new CFClient::UI::VBox);	732	child => (my $vbox = new CFClient::UI::VBox);
650		733
651	$vbox->add ($LOGVIEW = new CFClient::UI::TextView	734	$vbox->add ($LOGVIEW = new CFClient::UI::TextView
652	expand => 1,	735	expand => 1,
		736	font => $FONT_FIXED,
653	fontsize => $::CFG->{log_fontsize},	737	fontsize => $::CFG->{log_fontsize},
654	);	738	);
655		739
656	$vbox->add (my $input = new CFClient::UI::Entry	740	$vbox->add (my $input = new CFClient::UI::Entry
657	connect_focus_in => sub {	741	connect_focus_in => sub {
…		…
764	$BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup	848	$BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
765	}	849	}
766		850
767	sub video_shutdown {	851	sub video_shutdown {
768	$CFClient::UI::ROOT->{children} = [];	852	$CFClient::UI::ROOT->{children} = [];
		853	undef $CFClient::UI::GRAB;
		854	undef $CFClient::UI::HOVER;
769	undef $SDL_ACTIVE;	855	undef $SDL_ACTIVE;
770	}	856	}
771		857
772	my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#	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#
773	my $bgmusic;#TODO#hack#d#	859	my $bgmusic;#TODO#hack#d#
…		…
1054	}	1140	}
1055		1141
1056	gotid:	1142	gotid:
1057	$face->{id} = $id;	1143	$face->{id} = $id;
1058	$MAP->set_face ($facenum => $id);	1144	$MAP->set_face ($facenum => $id);
		1145	$self->{faceid}[$facenum] = $id;#d#
1059	$TILECACHE->get ($id)	1146	$TILECACHE->get ($id)
1060	}	1147	}
1061		1148
1062	sub conn::face_update {	1149	sub conn::face_update {
1063	my ($self, $facenum, $face) = @_;	1150	my ($self, $facenum, $face) = @_;
…		…
1071	my ($self, $id, $data) = @_;	1158	my ($self, $id, $data) = @_;
1072		1159
1073	$self->{texture}[$id] \|\|= do {	1160	$self->{texture}[$id] \|\|= do {
1074	my $tex =	1161	my $tex =
1075	new_from_image CFClient::Texture	1162	new_from_image CFClient::Texture
1076	$data, minify => 1;	1163	$data, minify => 1, mipmap => 1;
1077		1164
1078	$MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});	1165	$MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
1079	$MAPWIDGET->update;	1166	$MAPWIDGET->update;
1080		1167
1081	$tex	1168	$tex
…		…
1093		1180
1094	$chunk->play;	1181	$chunk->play;
1095	# warn "sound $x,$y,$soundnum,$type\n";#d#	1182	# warn "sound $x,$y,$soundnum,$type\n";#d#
1096	}	1183	}
1097		1184
		1185	my $LAST_QUERY; # server is stupid, stupid, stupid
		1186
1098	sub conn::query {	1187	sub conn::query {
1099	my ($self, $flags, $prompt) = @_;	1188	my ($self, $flags, $prompt) = @_;
1100		1189
1101	#TODO, display dialog with relevant information	1190	$prompt = $LAST_QUERY unless length $prompt;
1102	warn "<<<<QUERY:$flags:$prompt>>>\n";#d#	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;
1103	}	1250	}
1104		1251
1105	sub conn::drawinfo {	1252	sub conn::drawinfo {
1106	my ($self, $color, $text) = @_;	1253	my ($self, $color, $text) = @_;
1107		1254
…		…
1125	}	1272	}
1126		1273
1127	sub conn::spell_add {	1274	sub conn::spell_add {
1128	my ($self, $spell) = @_;	1275	my ($self, $spell) = @_;
1129		1276
		1277	# TODO
		1278	# create a widget dynamically, using spell face (CF::Protocol downloads them)
1130	$MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message}, sub {	1279	$MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message});
1131	});
1132	$MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message}, sub {	1280	$MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message});
1133	});
1134	}	1281	}
1135		1282
1136	sub conn::spell_delete {	1283	sub conn::spell_delete {
1137	my ($self, $spell) = @_;	1284	my ($self, $spell) = @_;
1138	}	1285	}
1139		1286
1140	sub conn::addme_success {	1287	sub conn::addme_success {
1141	my ($self) = @_;	1288	my ($self) = @_;
1142		1289
1143	for my $skill (values %{$self->{skill_info}}) {	1290	for my $skill (values %{$self->{skill_info}}) {
1144	$MAPWIDGET->add_command ("ready_skill $skill", "", sub {	1291	$MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'");
1145	});	1292	$MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'");
1146	$MAPWIDGET->add_command ("use_skill $skill", "", sub {
1147	});
1148	}	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	});
		1346	refresh;
		1347	}
		1348
		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 {
		1373	my ($self, $item) = @_;
		1374
		1375	update_floorbox if $item->{container} == 0;
1149	}	1376	}
1150		1377
1151	%SDL_CB = (	1378	%SDL_CB = (
1152	CFClient::SDL_QUIT => sub {	1379	CFClient::SDL_QUIT => sub {
1153	Event::unloop -1;	1380	Event::unloop -1;
…		…
1188	sdl_mode => 0,	1415	sdl_mode => 0,
1189	width => 640,	1416	width => 640,
1190	height => 480,	1417	height => 480,
1191	fullscreen => 0,	1418	fullscreen => 0,
1192	fast => 0,	1419	fast => 0,
		1420	map_scale => 0.5,
1193	fow_enable => 1,	1421	fow_enable => 1,
1194	fow_intensity => 0.45,	1422	fow_intensity => 0.45,
1195	fow_smooth => 0,	1423	fow_smooth => 0,
1196	gui_fontsize => 1,	1424	gui_fontsize => 1,
1197	log_fontsize => 1,	1425	log_fontsize => 1,
…		…
1219	@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";	1447	@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
1220		1448
1221	$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;	1449	$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
1222		1450
1223	{	1451	{
1224	my @fonts = map CFClient::find_rcfile $_, qw(uifont.ttf uifontb.ttf uifonti.ttf uifontbi.ttf);	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	);
1225		1462
1226	CFClient::add_font $_ for @fonts;	1463	CFClient::add_font $_ for @fonts;
1227	CFClient::set_font $fonts[0];	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;
1228	}	1469	}
1229		1470
1230	video_init;	1471	video_init;
1231	audio_init;	1472	audio_init;
1232		1473
1233	Event::loop;	1474	Event::loop;
1234		1475
1235	END { CFClient::SDL_Quit }	1476	END { CFClient::SDL_Quit }
1236		1477
		1478	=head1 pclient - Crossfire+ and Crossfire game client
1237		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

Comparing deliantra/Deliantra-Client/bin/pclient (file contents): Revision 1.167 by root, Sun Apr 23 05:33:24 2006 UTC vs. Revision 1.178 by root, Tue Apr 25 08:39:18 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/bin/pclient (file contents):
Revision 1.167 by root, Sun Apr 23 05:33:24 2006 UTC vs.
Revision 1.178 by root, Tue Apr 25 08:39:18 2006 UTC