ViewVC Help

View File | Revision Log | Show Annotations | Download File

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

Comparing deliantra/Deliantra-Client/bin/pclient (file contents):
Revision 1.106 by root, Fri Apr 14 22:26:28 2006 UTC vs.
Revision 1.206 by root, Tue May 9 22:27:55 2006 UTC

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

Diff Legend

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