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.206 by root, Tue May 9 22:27:55 2006 UTC vs.
Revision 1.249 by root, Thu May 25 02:23:14 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	# do things only needed for single-binary version (par)
6	BEGIN {	7	BEGIN {
7	if (%PAR::LibCache) {	8	if (%PAR::LibCache) {
8	@INC = grep ref, @INC; # weed out all paths except pars loader refs	9	@INC = grep ref, @INC; # weed out all paths except pars loader refs
9		10
10	while (my ($filename, $zip) = each %PAR::LibCache) {	11	while (my ($filename, $zip) = each %PAR::LibCache) {
…		…
13	$zip->extractMember ($_, "$ENV{PAR_TEMP}/$1")	14	$zip->extractMember ($_, "$ENV{PAR_TEMP}/$1")
14	unless -e "$ENV{PAR_TEMP}/$1";	15	unless -e "$ENV{PAR_TEMP}/$1";
15	}	16	}
16	}	17	}
17		18
		19	# TODO: pango-rc file, anybody?
		20
18	unshift @INC, $ENV{PAR_TEMP};	21	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	}	22	}
24	}	23	}
25		24
26	# need to do it again because that pile of garbage called PAR nukes it before main	25	# need to do it again because that pile of garbage called PAR nukes it before main
27	unshift @INC, $ENV{PAR_TEMP};	26	unshift @INC, $ENV{PAR_TEMP}
		27	if %PAR::LibCache;
28		28
29	use Time::HiRes 'time';	29	use Time::HiRes 'time';
		30	use Pod::POM;
30	use Event;	31	use Event;
31		32
32	use Crossfire;	33	use Crossfire;
33	use Crossfire::Protocol;	34	use Crossfire::Protocol;
34		35
…		…
37	use CFClient;	38	use CFClient;
38	use CFClient::UI;	39	use CFClient::UI;
39	use CFClient::MapWidget;	40	use CFClient::MapWidget;
40		41
41	$Event::DIED = sub {	42	$Event::DIED = sub {
		43	# TODO: display dialog box or so
42	CFClient::error $_[1];	44	CFClient::error $_[1];
43	};	45	};
44		46
45	#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#	47	#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#
46		48
…		…
80	our $BUTTONBAR;	82	our $BUTTONBAR;
81	our $LOGVIEW;	83	our $LOGVIEW;
82	our $CONSOLE;	84	our $CONSOLE;
83	our $METASERVER;	85	our $METASERVER;
84	our $LOGIN_BUTTON;	86	our $LOGIN_BUTTON;
		87	our $QUIT_DIALOG;
85		88
86	our $FLOORBOX;	89	our $FLOORBOX;
87	our $GAUGES;	90	our $GAUGES;
88	our $STATWIDS;	91	our $STATWIDS;
89		92
…		…
93	our $SDL_MIXER;	96	our $SDL_MIXER;
94	our @SOUNDS; # event => file mapping	97	our @SOUNDS; # event => file mapping
95	our %AUDIO_CHUNKS; # audio files	98	our %AUDIO_CHUNKS; # audio files
96		99
97	our $ALT_ENTER_MESSAGE;	100	our $ALT_ENTER_MESSAGE;
98	our $STATUS_LINE;	101	our $STATUSBOX;
99	our $DEBUG_STATUS;	102	our $DEBUG_STATUS;
100		103
101	our $INVWIN;	104	our $INVWIN;
102	our $INV;	105	our $INV;
		106	our $INVR;
		107	our $INVR_LBL;
		108	our $OPENCONT;
103		109
104	sub status {	110	sub status {
105	$STATUS_LINE->set_text ($_[0]);	111	$STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 20, fg => [1, 1, 0, 1]);
106	$STATUS_LINE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $STATUS_LINE->{h});
107	}	112	}
108		113
109	sub debug {	114	sub debug {
110	$DEBUG_STATUS->set_text ($_[0]);	115	$DEBUG_STATUS->set_text ($_[0]);
111	my ($w, $h) = $DEBUG_STATUS->size_request;	116	my ($w, $h) = $DEBUG_STATUS->size_request;
…		…
132	maph => $mapsize,	137	maph => $mapsize,
133	;	138	;
134	};	139	};
135		140
136	if ($CONN) {	141	if ($CONN) {
		142	CFClient::lowdelay fileno $CONN->{fh};
		143
137	$LOGIN_BUTTON->set_text ("Logout");	144	$LOGIN_BUTTON->set_text ("Logout");
138
139	status "login successful";	145	status "login successful";
140		146
141	CFClient::lowdelay fileno $CONN->{fh};	147	$BUTTONBAR->{children}[1]->emit ("activate")
		148	if $BUTTONBAR->{children}[1]->{state};
		149
142	} else {	150	} else {
143	status "unable to connect";	151	status "unable to connect";
144	stop_game();	152	stop_game();
145	}	153	}
146	}	154	}
…		…
150		158
151	status "connection closed";	159	status "connection closed";
152	$LOGIN_BUTTON->set_text ("Login");	160	$LOGIN_BUTTON->set_text ("Login");
153	$CONN->destroy;	161	$CONN->destroy;
154	$CONN = 0; # false, does not autovivify	162	$CONN = 0; # false, does not autovivify
		163
		164	$BUTTONBAR->{children}[1]->emit ("activate")
		165	unless $BUTTONBAR->{children}[1]->{state};
155		166
156	undef $MAPCACHE;	167	undef $MAPCACHE;
157	undef $MAP;	168	undef $MAP;
158	}	169	}
159		170
…		…
164	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);	175	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
165		176
166	$table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");	177	$table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");
167	$table->add (1, 0, my $hbox = new CFClient::UI::HBox);	178	$table->add (1, 0, my $hbox = new CFClient::UI::HBox);
168		179
169	$hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1]);	180	$hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1]);
170	$hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");	181	$hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");
171		182
172	$mode_slider->connect (changed => sub {	183	$mode_slider->connect (changed => sub {
173	my ($self, $value) = @_;	184	my ($self, $value) = @_;
174		185
…		…
199	}	210	}
200	);	211	);
201		212
202	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");	213	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
203	$table->add (1, $row++, new CFClient::UI::Slider	214	$table->add (1, $row++, new CFClient::UI::Slider
204	range => [$CFG->{map_scale}, 0.25, 2, 0.05],	215	range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
205	tooltip => "Enlarge or shrink the displayed map",	216	tooltip => "Enlarge or shrink the displayed map",
206	connect_changed => sub {	217	connect_changed => sub {
207	my ($self, $value) = @_;	218	my ($self, $value) = @_;
208	$CFG->{map_scale} = 0.05 * int $value / 0.05;	219	$CFG->{map_scale} = 2 ** $value;
209	}	220	}
210	);	221	);
211		222
212	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");	223	$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	224	$table->add (1, $row++, new CFClient::UI::CheckBox
…		…
219	}	230	}
220	);	231	);
221		232
222	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");	233	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
223	$table->add (1, $row++, new CFClient::UI::Slider	234	$table->add (1, $row++, new CFClient::UI::Slider
224	range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001],	235	range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],
225	tooltip => "The higher the intensity, the lighter the Fog-of-War color",	236	tooltip => "The higher the intensity, the lighter the Fog-of-War color",
226	connect_changed => sub {	237	connect_changed => sub {
227	my ($self, $value) = @_;	238	my ($self, $value) = @_;
228	$CFG->{fow_intensity} = $value;	239	$CFG->{fow_intensity} = $value;
229	}	240	}
…		…
240	}	251	}
241	);	252	);
242		253
243	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");	254	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
244	$table->add (1, $row++, new CFClient::UI::Slider	255	$table->add (1, $row++, new CFClient::UI::Slider
245	range => [$CFG->{gui_fontsize}, 0.5, 2, 0.1],	256	range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],
246	tooltip => "The font size used by most GUI elements",	257	tooltip => "The font size used by most GUI elements",
247	connect_changed => sub {	258	connect_changed => sub { $CFG->{gui_fontsize} = $_[1] },
248	$CFG->{gui_fontsize} = 0.1 * int $_[1] * 10;
249	# $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
250	}
251	);	259	);
252		260
253	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Server Log Fontsize");	261	$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	262	$table->add (1, $row++, new CFClient::UI::Slider
255	range => [$CFG->{log_fontsize}, 0.5, 2, 0.1],	263	range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],
256	tooltip => "The font size used by the server log window only",	264	tooltip => "The font size used by the server log window only",
257	connect_changed => sub {	265	connect_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]) },
258	$LOGVIEW->set_fontsize ($CFG->{log_fontsize} = 0.1 * int $_[1] * 10);
259	}
260	);	266	);
261		267
262	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");	268	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
263		269
264	$table->add (1, $row++, new CFClient::UI::Slider	270	$table->add (1, $row++, new CFClient::UI::Slider
265	range => [$CFG->{stat_fontsize}, 0.5, 2, 0.1],	271	range => [$CFG->{stat_fontsize}, 0.5, 2, 0, 0.1],
266	tooltip => "The font size used by the statistics window only",	272	tooltip => "The font size used by the statistics window only",
267	connect_changed => sub {	273	connect_changed => sub {
268	$CFG->{stat_fontsize} = 0.1 * int $_[1] * 10;	274	$CFG->{stat_fontsize} = $_[1];
269	&set_stats_window_fontsize;	275	&set_stats_window_fontsize;
		276	}
		277	);
		278
		279	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
		280	$table->add (1, $row++, new CFClient::UI::Slider
		281	range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],
		282	tooltip => "Adjusts the fontsize of the gauges at the bottom right",
		283	connect_changed => sub {
		284	$CFG->{gauge_fontsize} = $_[1];
		285	&set_gauge_window_fontsize;
270	}	286	}
271	);	287	);
272		288
273	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");	289	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
274	$table->add (1, $row++, new CFClient::UI::Slider	290	$table->add (1, $row++, new CFClient::UI::Slider
275	range => [$CFG->{gauge_size}, 0.2, 0.8, 0.02],	291	range => [$CFG->{gauge_size}, 0.2, 0.8],
276	tooltip => "Adjust the size of the stats gauges at the bottom right",	292	tooltip => "Adjust the size of the stats gauges at the bottom right",
277	connect_changed => sub {	293	connect_changed => sub {
278	$CFG->{gauge_size} = $_[1];	294	$CFG->{gauge_size} = $_[1];
279	my $h = int $HEIGHT * $CFG->{gauge_size};	295	$GAUGES->{win}->set_size ($WIDTH, 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	}	296	}
293	);	297	);
294		298
295	$table->add (1, $row++, new CFClient::UI::Button	299	$table->add (1, $row++, new CFClient::UI::Button
296	expand => 1, align => 0, text => "Apply",	300	expand => 1, align => 0, text => "Apply",
…		…
321	connect_changed => sub {	325	connect_changed => sub {
322	$CFG->{bgm_enable} = $_[1];	326	$CFG->{bgm_enable} = $_[1];
323	}	327	}
324	);	328	);
325	$hbox->add (new CFClient::UI::Slider	329	$hbox->add (new CFClient::UI::Slider
326	expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0.1],	330	expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],
327	tooltip => "The volume of the background music",	331	tooltip => "The volume of the background music",
328	connect_changed => sub {	332	connect_changed => sub {
329	$CFG->{bgm_volume} = $_[1];	333	$CFG->{bgm_volume} = $_[1];
330	CFClient::MixMusic::volume $_[1] * 128;	334	CFClient::MixMusic::volume $_[1] * 128;
331	}	335	}
…		…
338	audio_shutdown ();	342	audio_shutdown ();
339	audio_init ();	343	audio_init ();
340	}	344	}
341	);	345	);
342		346
343	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Communication cmd");	347	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Chat Command");
344	$table->add (1, $row++, my $saycmd = new CFClient::UI::Entry	348	$table->add (1, $row++, my $saycmd = new CFClient::UI::Entry
345	text => $CFG->{say_command},	349	text => $CFG->{say_command},
346	tooltip => "This is the command that will be used if you write a line in the message window entry. "	350	tooltip => "This is the command that will be used if you write a line in the message window entry or press <b>\"</b> in the map window. "
347	."Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "	351	. "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.",	352	. "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
349	connect_changed => sub {	353	connect_changed => sub {
350	my ($self, $value) = @_;	354	my ($self, $value) = @_;
351	$CFG->{say_command} = $value;	355	$CFG->{say_command} = $value;
352	}	356	}
353	);	357	);
…		…
363		367
364	sub set_gauge_window_fontsize {	368	sub set_gauge_window_fontsize {
365	for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {	369	for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {
366	$_->set_fontsize ($::CFG->{gauge_fontsize});	370	$_->set_fontsize ($::CFG->{gauge_fontsize});
367	}	371	}
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	}
372		373
373	sub make_gauge_window {	374	sub make_gauge_window {
374	my $gh = int ($HEIGHT * $CFG->{gauge_size});	375	my $gh = int $HEIGHT * $CFG->{gauge_size};
375	# my $gw = int ($WIDTH * $CFG->{gauge_w_size});
376		376
377	my $win = new CFClient::UI::Frame (	377	my $win = new CFClient::UI::Frame (
378	y => $HEIGHT - $gh, x => 0, user_w => $WIDTH, user_h => $gh	378	req_y => -1,
		379	user_w => $WIDTH,
		380	user_h => $gh,
379	);	381	);
		382
380	$win->add (my $hbox = new CFClient::UI::HBox	383	$win->add (my $hbox = new CFClient::UI::HBox
381	children => [	384	children => [
382	(new CFClient::UI::HBox expand => 1),	385	(new CFClient::UI::HBox expand => 1),
383	($FLOORBOX = new CFClient::UI::VBox),	386	(new CFClient::UI::VBox children => [
		387	(new CFClient::UI::Empty expand => 1),
		388	(new CFClient::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new CFClient::UI::VBox)),
		389	]),
384	(my $vbox = new CFClient::UI::VBox),	390	(my $vbox = new CFClient::UI::VBox),
385	],	391	],
386	);	392	);
387		393
388	$vbox->add (new CFClient::UI::HBox	394	$vbox->add (new CFClient::UI::HBox
…		…
392	(my $hb = new CFClient::UI::HBox),	398	(my $hb = new CFClient::UI::HBox),
393	],	399	],
394	);	400	);
395		401
396	$hb->add (my $hg = new CFClient::UI::Gauge type => 'hp',	402	$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.");	403	tooltip => "<b>Health points</b>. 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',	404	$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.");	405	tooltip => "<b>Spell points</b>. 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',	406	$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.");	407	tooltip => "<b>Grace points</b> - 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',	408	$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.");	409	tooltip => "<b>Food</b>. 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		410
405	$vbox->add (my $exp = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,	411	$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.");	412	tooltip => "<b>Experience points and overall level</b> - 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,	413	$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.)");	414	tooltip => "<b>Ranged attack</b> - how you attack when you press shift-cursor (spell, skill, weapon etc.)");
409		415
410	$GAUGES = {	416	$GAUGES = {
411	exp => $exp, win => $win, range => $rng,	417	exp => $exp, win => $win, range => $rng,
412	food => $fg, mana => $mg, hp => $hg, grace => $gg	418	food => $fg, mana => $mg, hp => $hg, grace => $gg
413	};	419	};
…		…
416		422
417	$win	423	$win
418	}	424	}
419		425
420	sub make_stats_window {	426	sub make_stats_window {
421	my $tgw = new CFClient::UI::FancyFrame x => $WIDTH * 2/5, y => 0, title => "Stats";	427	my $tgw = new CFClient::UI::FancyFrame title => "Stats";
422		428
423	$tgw->add (new CFClient::UI::Window child => my $vb = new CFClient::UI::VBox);	429	$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);	430	$vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,
		431	can_hover => 1, can_events => 1,
		432	tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");
425	$vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1);	433	$vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,
		434	can_hover => 1, can_events => 1,
		435	tooltip => "The map you are currently on (if supported by the server).");
426		436
427	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);	437	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
428
429	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);	438	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);
430		439
431	my $black = [0, 0, 0];	440	my $color2 = [1, 1, 0];
432		441
433	for (	442	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"],	443	[0, 0, st_str => "Str", 30, "<b>Physical Strength</b>, 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"],	444	[0, 1, st_dex => "Dex", 30, "<b>Dexterity</b>, 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"],	445	[0, 2, st_con => "Con", 30, "<b>Constitution</b>, 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"],	446	[0, 3, st_int => "Int", 30, "<b>Intelligence</b>, 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"],	447	[0, 4, st_wis => "Wis", 30, "<b>Wisdom</b>, 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"],	448	[0, 5, st_pow => "Pow", 30, "<b>Power</b>, 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."],	449	[0, 6, st_cha => "Cha", 30, "<b>Charisma</b>, how well you are received by NPCs. Affects buying and selling prices in shops."],
441		450
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."],	451	[2, 0, st_wc => "Wc", -120, "<b>Weapon Class</b>, 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."],	452	[2, 1, st_ac => "Ac", -120, "<b>Armour Class</b>, 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."],	453	[2, 2, st_dam => "Dam", 120, "<b>Damage</b>, 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."],	454	[2, 3, st_arm => "Arm", 120, "<b>Armour</b>, 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."],	455	[2, 4, st_spd => "Spd", 10.54, "<b>Speed</b>, 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."],	456	[2, 5, st_wspd => "WSp", 10.54, "<b>Weapon Speed</b>, 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	) {	457	) {
449	my ($col, $row, $id, $label, $template, $tooltip) = @$_;	458	my ($col, $row, $id, $label, $template, $tooltip) = @$_;
450		459
451	$tbl->add ($col , $row, $STATWIDS->{$id} = new CFClient::UI::Label	460	$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);	461	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	462	$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);	463	font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $color2, valign => 0, align => -1, text => $label, tooltip => $tooltip);
455	}	464	}
456		465
457	$hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);	466	$hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);
458		467
459	my $row = 0;	468	my $row = 0;
460	my $col = 0;	469	my $col = 0;
461		470
462	my %resist_names = (	471	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.)",	472	slow => "<b>Slow</b> (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.)",	473	holyw => "<b>Holy Word</b> (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.)",	474	conf => "<b>Confusion</b> (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, ...)",	475	fire => "<b>Fire</b> (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)",	476	depl => "<b>Depletion</b> (some monsters and other effects can cause stats depletion)",
468	magic => "Magic (resistance to magic spells like magic missile or similar)",	477	magic => "<b>Magic</b> (resistance to magic spells like magic missile or similar)",
469	drain => "Draining (some monsters (e.g. vampires) and other effects can steal experience)",	478	drain => "<b>Draining</b> (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)",	479	acid => "<b>Acid</b> (resistance to acid, acid hurts pretty much and also corrodes your weapons)",
471	pois => "Poison (resistance to getting poisoned)",	480	pois => "<b>Poison</b> (resistance to getting poisoned)",
472	para => "Paralysation (this resistance affects the chance you get paralysed)",	481	para => "<b>Paralysation</b> (this resistance affects the chance you get paralysed)",
473	deat => "Death (resistance against death spells)",	482	deat => "<b>Death</b> (resistance against death spells)",
474	phys => "Physical (this is the resistance against physical attacks, like when a monster hit you in melee combat)",	483	phys => "<b>Physical</b> (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)",	484	blind => "<b>Blind</b> (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)",	485	fear => "<b>Fear</b> (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",	486	tund => "<b>Turn undead</b> (affects your resistancy to various forms of 'turn undead' spells. Only relevant when you are, in fact, undead...",
478	elec => "Electricity (resistance againt electricity, spells like large lightning, small lightning, ...)",	487	elec => "<b>Electricity</b> (resistance against electricity, spells like large lightning, small lightning, ...)",
479	cold => "Cold (this is your resistance against cold spells like icestorm, snowstorm, ...)",	488	cold => "<b>Cold</b> (this is your resistance against cold spells like icestorm, snowstorm, ...)",
480	ghit => "Ghost hit (special attack used by ghosts and ghost-like beings)",	489	ghit => "<b>Ghost hit</b> (special attack used by ghosts and ghost-like beings)",
481	);	490	);
482	for (qw/slow holyw conf fire depl magic	491	for (qw/slow holyw conf fire depl magic
483	drain acid pois para deat phys	492	drain acid pois para deat phys
484	blind fear tund elec cold ghit/)	493	blind fear tund elec cold ghit/)
485	{	494	{
…		…
665	$HOST->set_text ($CFG->{host} = $host);	674	$HOST->set_text ($CFG->{host} = $host);
666	}),	675	}),
667	(new CFClient::UI::Empty expand => 1),	676	(new CFClient::UI::Empty expand => 1),
668	]);	677	]);
669		678
670	$table->add ($_ + 1, $y, new CFClient::UI::Label align => $align[$_], text => $m->[$_], fontsize => 0.8)	679	$table->add ($_ + 1, $y, new CFClient::UI::Label
		680	ellipsise => 0, align => $align[$_], text => $m->[$_], fontsize => 0.8)
671	for 0 .. $#$m;	681	for 0 .. $#$m;
672	}	682	}
673	}	683	}
674	});	684	});
675	}	685	}
…		…
731	);	741	);
732		742
733	$table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");	743	$table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
734	$table->add (1, 7, new CFClient::UI::Slider	744	$table->add (1, 7, new CFClient::UI::Slider
735	req_w => 100,	745	req_w => 100,
736	range => [$CFG->{mapsize}, 10, 100 + 1, 1],	746	range => [$CFG->{mapsize}, 10, 100, 0, 1],
737	tooltip => "This is the size of the portion of the map update the server sends you. "	747	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.",	748	. "If you set this to a high value you will be able to see further for example.",
739	connect_changed => sub {	749	connect_changed => sub {
740	my ($self, $value) = @_;	750	my ($self, $value) = @_;
741		751
742	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;	752	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;
743	},	753	},
744	);	754	);
745		755
		756	$table->add (0, 8, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");
		757	$table->add (1, 8, new CFClient::UI::Entry
		758	text => $CFG->{output_count},
		759	tooltip => "Should be set to 1 unless you know what you are doing",
		760	connect_changed => sub { $CFG->{output_count} = $_[1] },
		761	);
		762
		763	$table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");
		764	$table->add (1, 9, new CFClient::UI::Entry
		765	text => $CFG->{output_sync},
		766	tooltip => "Should be set to 1 unless you know what you are doing",
		767	connect_changed => sub { $CFG->{output_sync} = $_[1] },
		768	);
		769
746	$table->add (1, 8, $LOGIN_BUTTON = new CFClient::UI::Button	770	$table->add (1, 10, $LOGIN_BUTTON = new CFClient::UI::Button
747	expand => 1,	771	expand => 1,
748	align => 0,	772	align => 0,
749	text => "Login",	773	text => "Login",
750	connect_activate => sub {	774	connect_activate => sub {
751	$CONN ? stop_game	775	$CONN ? stop_game
…		…
758		782
759	sub message_window {	783	sub message_window {
760	my $window = new CFClient::UI::FancyFrame	784	my $window = new CFClient::UI::FancyFrame
761	title => "Messages",	785	title => "Messages",
762	border_bg => [1, 1, 1, 1],	786	border_bg => [1, 1, 1, 1],
763	bg => [0, 0, 0, 0.5],	787	bg => [0, 0, 0, 0.75],
764	user_w => int $::WIDTH / 3,	788	user_w => int $::WIDTH / 3,
765	user_h => int $::HEIGHT / 5,	789	user_h => int $::HEIGHT / 5,
766	child => (my $vbox = new CFClient::UI::VBox);	790	child => (my $vbox = new CFClient::UI::VBox);
767		791
768	$vbox->add ($LOGVIEW = new CFClient::UI::TextView	792	$vbox->add ($LOGVIEW);
769	expand => 1,
770	font => $FONT_FIXED,
771	fontsize => $::CFG->{log_fontsize},
772	);
773		793
774	$vbox->add (my $input = new CFClient::UI::Entry	794	$vbox->add (my $input = new CFClient::UI::Entry
		795	tooltip => "<b>Chat Box</b>. If you enter a text and press return/enter here, the current <i>communication command</i> "
		796	. "from the client setup will be prepended (e.g. <b>shout</b>, <b>chat</b>...). "
		797	. "If you prepend a slash (/), you will submit a command instead (similar to IRC). "
		798	. "A better way to submit commands (and the occasional chat command) is often the map command completer.",
775	connect_focus_in => sub {	799	connect_focus_in => sub {
776	my ($input, $prev_focus) = @_;	800	my ($input, $prev_focus) = @_;
777		801
778	delete $input->{refocus_map};	802	delete $input->{refocus_map};
779		803
…		…
808	};	832	};
809		833
810	$window	834	$window
811	}	835	}
812		836
		837	sub open_quit_dialog {
		838	unless ($QUIT_DIALOG) {
		839
		840	$QUIT_DIALOG = new CFClient::UI::FancyFrame title => "Really Quit?";
		841
		842	$QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);
		843
		844	$vb->add (new CFClient::UI::Label
		845	text => "You should find a savebed and apply it first!",
		846	max_w => $WIDTH * 0.25,
		847	ellipsize => 0,
		848	);
		849	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
		850	$hb->add (new CFClient::UI::Button
		851	text => "Ok",
		852	expand => 1,
		853	connect_activate => sub { $QUIT_DIALOG->hide },
		854	);
		855	$hb->add (new CFClient::UI::Button
		856	text => "Quit anyway",
		857	expand => 1,
		858	connect_activate => sub { exit },
		859	);
		860
		861	$QUIT_DIALOG->show_centered;
		862	} else {
		863	$QUIT_DIALOG->show_centered;
		864	}
		865	}
		866
813	sub make_inventory_window {	867	sub make_inventory_window {
814	my $invwin = new CFClient::UI::FancyFrame user_w => 300, user_h => 300, title => "Inventory";	868	my $invwin = new CFClient::UI::FancyFrame
		869	user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Inventory";
		870
		871	$invwin->add (my $hb = new CFClient::UI::HBox expand => 1);
		872
		873	$hb->add (my $vb1 = new CFClient::UI::VBox expand => 1);
		874	$vb1->add (my $lbl = new CFClient::UI::Label);
		875	$lbl->set_text ("Player");
815	$invwin->add ($INV = new CFClient::UI::Inventory expand => 1);	876	$vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
		877
		878	$hb->add (my $vb2 = new CFClient::UI::VBox expand => 1);
		879	$vb2->add ($INVR_LBL = new CFClient::UI::Label);
		880	$INVR_LBL->set_text ("Floor");
		881	$vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);
		882
816	$invwin	883	$invwin
		884	}
		885
		886	sub make_help_window {
		887	my $win = new CFClient::UI::FancyFrame
		888	user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Documentation";
		889
		890	$win->add (my $vbox = new CFClient::UI::VBox);
		891
		892	$vbox->add (my $buttons = new CFClient::UI::HBox);
		893	$vbox->add (my $viewer = new CFClient::UI::TextView expand => 1, fontsize => 0.8);
		894
		895	for (
		896	[intro => "Introduction"],
		897	[manual => "Manual"],
		898	[command_help => "Commands"],
		899	[skill_help => "Skills"],
		900	) {
		901	my ($pod, $label) = @$_;
		902
		903	$buttons->add (new CFClient::UI::Button
		904	text => $label,
		905	connect_activate => sub {
		906	my $parser = new Pod::POM;
		907	my $pom = $parser->parse_file (CFClient::find_rcfile "pod/$pod.pod");
		908
		909	$viewer->clear;
		910
		911	$viewer->add_paragraph ([1, 1, 1, 1], $_->[1], $_->[0])
		912	for @{ CFClient::pod_to_pango_list $pom };
		913
		914	$viewer->set_offset (0);
		915	},
		916	);
		917	}
		918
		919	$viewer->add_paragraph ([1, 1, 0, 1], "<big>Use one of the buttons above to display a document.</big>");
		920
		921	$win
817	}	922	}
818		923
819	sub sdl_init {	924	sub sdl_init {
820	CFClient::SDL_Init	925	CFClient::SDL_Init
821	and die "SDL::Init failed!\n";	926	and die "SDL::Init failed!\n";
…		…
824	sub video_init {	929	sub video_init {
825	sdl_init;	930	sdl_init;
826		931
827	$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;	932	$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
828		933
		934	my ($old_w, $old_h) = ($WIDTH, $HEIGHT);
		935
829	($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };	936	($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
830	$FULLSCREEN = $CFG->{fullscreen};	937	$FULLSCREEN = $CFG->{fullscreen};
831	$FAST = $CFG->{fast};	938	$FAST = $CFG->{fast};
832		939
833	CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN	940	CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
834	or die "SDL_SetVideoMode failed!\n";	941	or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";
835		942
836	$SDL_ACTIVE = 1;	943	$SDL_ACTIVE = 1;
837	$LAST_REFRESH = time - 0.01;	944	$LAST_REFRESH = time - 0.01;
838		945
839	CFClient::gl_init;	946	CFClient::gl_init;
…		…
843	$CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#	950	$CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
844		951
845	#############################################################################	952	#############################################################################
846		953
847	if ($DEBUG_STATUS) {	954	if ($DEBUG_STATUS) {
848	# reconfigure all widgets	955	CFClient::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
849	$CFClient::UI::ROOT->reconfigure;
850
851	} else {	956	} else {
852	# create the widgets	957	# create the widgets
853		958
854	$DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100, text => "hulla", x => 100;#d#	959	$DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100, req_x => -1;
855	$DEBUG_STATUS->show;	960	$DEBUG_STATUS->show;
856		961
857	$STATUS_LINE = new CFClient::UI::Label	962	$STATUSBOX = new CFClient::UI::Statusbox;
858	padding => 0,	963	$STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", pri => -100, color => [1, 1, 1, 0.8]);
859	y => $HEIGHT - $FONTSIZE * 1.8;
860	$STATUS_LINE->show;
861		964
862	$ALT_ENTER_MESSAGE = new CFClient::UI::Label	965	(new CFClient::UI::Frame
863	padding => 0,	966	bg => [0, 0, 0, 0.4],
864	fontsize => 0.8,	967	req_y => -1,
865	markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode";	968	child => $STATUSBOX,
866	$ALT_ENTER_MESSAGE->show;	969	)->show;
867	$ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h});
868		970
869	CFClient::UI::FancyFrame->new (	971	CFClient::UI::FancyFrame->new (
870	border_bg => [1, 1, 1, 192/255],	972	border_bg => [1, 1, 1, 192/255],
871	bg => [1, 1, 1, 0],	973	bg => [1, 1, 1, 0],
872	child => ($MAPMAP = new CFClient::MapWidget::MapMap),	974	child => ($MAPMAP = new CFClient::MapWidget::MapMap
		975	tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
		976	),
873	)->show;	977	)->show;
874		978
875	$MAPWIDGET = new CFClient::MapWidget;	979	$MAPWIDGET = new CFClient::MapWidget;
876	$MAPWIDGET->connect (activate_console => sub {	980	$MAPWIDGET->connect (activate_console => sub {
877	my ($mapwidget, $preset) = @_;	981	my ($mapwidget, $preset) = @_;
…		…
886	}	990	}
887	});	991	});
888	$MAPWIDGET->show;	992	$MAPWIDGET->show;
889	$MAPWIDGET->focus_in;	993	$MAPWIDGET->focus_in;
890		994
		995	$LOGVIEW = new CFClient::UI::TextView
		996	expand => 1,
		997	font => $FONT_FIXED,
		998	fontsize => $::CFG->{log_fontsize},
		999	can_hover => 1,
		1000	can_events => 1,
		1001	tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",
		1002	;
		1003
891	$BUTTONBAR = new CFClient::UI::HBox;	1004	$BUTTONBAR = new CFClient::UI::HBox;
892		1005
893	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup);	1006	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup,
		1007	tooltip => "Toggles a dialog where you can configure various aspects of the client, such as graphics mode, performance, and audio options.");
894	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup);	1008	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup,
		1009	tooltip => "Toggles a dialog where you can configure the server to play on, your username, password and other server-related options.");
895	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);	1010	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window,
		1011	tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
896		1012
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	1013	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		1014
899	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window);	1015	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window,
		1016	tooltip => "Toggles the statistics window, where all your Stats and Resistances are being displayed at all times.");
900	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => make_inventory_window);	1017	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => make_inventory_window,
		1018	tooltip => "Toggles the inventory window, where you can manage your loot (or treaures :).");
901		1019
902	$BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {	1020	$BUTTONBAR->add (new CFClient::UI::Button
		1021	text => "Save Config",
		1022	tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
		1023	connect_activate => sub {
903	CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";	1024	CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
904	status "Configuration Saved";	1025	status "Configuration Saved";
		1026	},
905	});	1027	);
		1028
		1029	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => make_help_window,
		1030	tooltip => "View Documentation");
		1031
		1032	$BUTTONBAR->add (new CFClient::UI::Button
		1033	text => "Quit",
		1034	tooltip => "Terminates the program",
		1035	connect_activate => sub {
		1036	if ($CONN) {
		1037	open_quit_dialog;
		1038	} else {
		1039	exit;
		1040	}
		1041	},
		1042	);
906		1043
907	$BUTTONBAR->show;	1044	$BUTTONBAR->show;
908		1045
		1046	$STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
		1047
909	# delay till geometry is constant	1048	# delay till geometry is constant
910	$CFClient::UI::ROOT->on_refresh (startup => sub {	1049	$CFClient::UI::ROOT->on_post_alloc (startup => sub {
911	$BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup	1050	$BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
		1051	my $widget = $GAUGES->{win};
		1052	$widget->move (0, $HEIGHT - $widget->{h});#d# to in toplevel
912	});	1053	});
913	force_refresh ();	1054	force_refresh ();
914	}	1055	}
915	}	1056	}
916		1057
…		…
922	my $bgmusic;#TODO#hack#d#	1063	my $bgmusic;#TODO#hack#d#
923		1064
924	sub audio_channel_finished {	1065	sub audio_channel_finished {
925	my ($channel) = @_;	1066	my ($channel) = @_;
926		1067
927	warn "channel $channel finished\n";#d#	1068	#warn "channel $channel finished\n";#d#
928	}	1069	}
929		1070
930	sub audio_music_finished {	1071	sub audio_music_finished {
931	return unless $CFG->{bgm_enable};	1072	return unless $CFG->{bgm_enable};
932		1073
…		…
939		1080
940	sub audio_init {	1081	sub audio_init {
941	if ($CFG->{audio_enable}) {	1082	if ($CFG->{audio_enable}) {
942	if (open my $fh, "<", CFClient::find_rcfile "sounds/config") {	1083	if (open my $fh, "<", CFClient::find_rcfile "sounds/config") {
943	$SDL_MIXER = !CFClient::Mix_OpenAudio;	1084	$SDL_MIXER = !CFClient::Mix_OpenAudio;
		1085
		1086	unless ($SDL_MIXER) {
		1087	status "Unable to open sound device: there will be no sound";
		1088	return;
		1089	}
		1090
944	CFClient::Mix_AllocateChannels 8;	1091	CFClient::Mix_AllocateChannels 8;
945	CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;	1092	CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
946		1093
947	audio_music_finished;	1094	audio_music_finished;
948		1095
…		…
976	my %animate_object;	1123	my %animate_object;
977	my $animate_timer;	1124	my $animate_timer;
978		1125
979	my $fps = 9;	1126	my $fps = 9;
980		1127
		1128	my %demo;#d#
		1129
981	sub force_refresh {	1130	sub force_refresh {
982	$fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05;	1131	$fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
983	debug sprintf "%3.2f", $fps;	1132	debug sprintf "%3.2f", $fps;
984		1133
985	$CFClient::UI::ROOT->draw;	1134	$CFClient::UI::ROOT->draw;
986	CFClient::SDL_GL_SwapBuffers;
987		1135
988	$WANT_REFRESH = 0;	1136	$WANT_REFRESH = 0;
989	$CAN_REFRESH = 0;	1137	$CAN_REFRESH = 0;
990	$LAST_REFRESH = $NOW;	1138	$LAST_REFRESH = $NOW;
		1139
		1140	0 && do {
		1141	# some weird model-drawing code, just a joke right now
		1142	use CFClient::OpenGL;
		1143
		1144	$demo{t}{eye_auv} ||= new_from_file CFClient::Texture "eye2.png" or die;
		1145	$demo{t}{body_auv} ||= new_from_file CFClient::Texture "body_auv3.png" or die;
		1146	$demo{r} ||= do {
		1147	my $mod = Compress::LZF::sthaw do { local $/; open my $fh, "<:raw:perlio", "dread.lz3"; <$fh> };
		1148	$mod->{v} = pack "f*", @{$mod->{v}};
		1149	$_ = [scalar @$_, pack "S!*", @$_]
		1150	for values %{$mod->{g}};
		1151	$mod
		1152	};
		1153
		1154	my $r = $demo{r} or die;
		1155
		1156	glDepthMask 1;
		1157	glClear GL_DEPTH_BUFFER_BIT;
		1158	glEnable GL_TEXTURE_2D;
		1159	glEnable GL_DEPTH_TEST;
		1160	glEnable GL_CULL_FACE;
		1161	glShadeModel $::FAST ? GL_FLAT : GL_SMOOTH;
		1162
		1163	glMatrixMode GL_PROJECTION;
		1164	glLoadIdentity;
		1165	glFrustum -1 * ($::WIDTH / $::HEIGHT), 1 * ($::WIDTH / $::HEIGHT), 1, -1, 1, 10000;
		1166	#glOrtho 0, $::WIDTH, 0, $::HEIGHT, -10000, 10000;
		1167	glMatrixMode GL_MODELVIEW;
		1168	glLoadIdentity;
		1169
		1170	glPushMatrix;
		1171	glTranslate 0, 0, -800;
		1172	glScale 1, -1, 1;
		1173	glRotate $NOW * 1000 % 36000 / 5, 0, 1, 0;
		1174	glRotate $NOW * 1000 % 36000 / 6, 1, 0, 0;
		1175	glRotate $NOW * 1000 % 36000 / 7, 0, 0, 1;
		1176	glScale 50, 50, 50;
		1177
		1178	glInterleavedArrays GL_T2F_N3F_V3F, 0, $r->{v};
		1179	while (my ($k, $v) = each %{$r->{g}}) {
		1180	glBindTexture GL_TEXTURE_2D, ($demo{t}{$k}{name} or die);
		1181	glDrawElements GL_TRIANGLES, $v->[0], GL_UNSIGNED_SHORT, $v->[1];
		1182	}
		1183
		1184	glPopMatrix;
		1185
		1186	glShadeModel GL_FLAT;
		1187	glDisable GL_DEPTH_TEST;
		1188	glDisable GL_TEXTURE_2D;
		1189	glDepthMask 0;
		1190
		1191	$WANT_REFRESH++;
		1192	};
		1193
		1194	CFClient::SDL_GL_SwapBuffers;
991	}	1195	}
992		1196
993	my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {	1197	my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {
994	$NOW = time;	1198	$NOW = time;
995		1199
…		…
1018	delete $animate_object{$widget};	1222	delete $animate_object{$widget};
1019	}	1223	}
1020		1224
1021	@conn::ISA = Crossfire::Protocol::;	1225	@conn::ISA = Crossfire::Protocol::;
1022		1226
		1227	sub conn::new {
		1228	my $class = shift;
		1229
		1230	my $self = $class->Crossfire::Protocol::new (@_);
		1231
		1232	$MAPWIDGET->clr_commands;
		1233
		1234	my $parser = new Pod::POM;
		1235	my $pod = $parser->parse_file (CFClient::find_rcfile "pod/command_help.pod");
		1236
		1237	for my $head2 ($pod->head2) {
		1238	$head2->title =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x
		1239	or next;
		1240
		1241	my $cmd = $1;
		1242	my @args = split /\|/, $2;
		1243	@args = (".*") unless @args;
		1244
		1245	my $text = CFClient::pod_to_pango $head2->content;
		1246
		1247	for my $arg (@args) {
		1248	$arg = $arg eq ".*" ? "" : " $arg";
		1249
		1250	$MAPWIDGET->add_command ("$cmd$arg", $text);
		1251	}
		1252	}
		1253
		1254	$self->{noface} = new_from_file CFClient::Texture
		1255	CFClient::find_rcfile "noface.png", minify => 1, mipmap => 1;
		1256
		1257	$self
		1258	}
		1259
1023	sub conn::stats_update {	1260	sub conn::stats_update {
1024	my ($self, $stats) = @_;	1261	my ($self, $stats) = @_;
		1262
		1263	if (my $exp = $stats->{Crossfire::Protocol::CS_STAT_EXP64}) {
		1264	my $diff = $exp - $self->{prev_exp};
		1265	$STATUSBOX->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5)
		1266	if exists $self->{prev_exp} && $diff;
		1267	$self->{prev_exp} = $exp;
		1268	}
1025		1269
1026	update_stats_window ($stats);	1270	update_stats_window ($stats);
1027	}	1271	}
1028		1272
1029	sub conn::user_send {	1273	sub conn::user_send {
…		…
1084	$self->set_texture ($id => $data);	1328	$self->set_texture ($id => $data);
1085	}	1329	}
1086	}	1330	}
1087	}	1331	}
1088		1332
		1333	# hardcode /world/world_xxx_xxx map names, the savings are enourmous,
		1334	# (server resource,s latency, bandwidth), so this hack is warranted.
		1335	# the right fix is to make real tiled maps with an overview file
		1336	sub conn::send_mapinfo {
		1337	my ($self, $data, $cb) = @_;
		1338
		1339	if ($self->{map_info}[0] =~ m%^/world/world_(\d\d\d)_(\d\d\d)$%) {
		1340	my ($wx, $wy) = ($1, $2);
		1341
		1342	if ($data =~ /^spatial ([1-4]+)$/) {
		1343	my @dx = (0, 0, 1, 0, -1);
		1344	my @dy = (0, -1, 0, 1, 0);
		1345	my ($dx, $dy);
		1346
		1347	for (split //, $1) {
		1348	$dx += $dx[$_];
		1349	$dy += $dy[$_];
		1350	}
		1351
		1352	$cb->(spatial => 15,
		1353	$self->{map_info}[1] - $MAP->ox + $dx * 50,
		1354	$self->{map_info}[2] - $MAP->oy + $dy * 50,
		1355	50, 50,
		1356	sprintf "/world/world_%03d_%03d", $wx + $dx, $wy + $dy
		1357	);
		1358
		1359	return;
		1360	}
		1361	}
		1362
		1363	$self->Crossfire::Protocol::send_mapinfo ($data, $cb);
		1364	}
		1365
1089	# this method does a "flood fill" into every tile direction	1366	# this method does a "flood fill" into every tile direction
1090	# it assumes that tiles are arranged in a rectangular grid,	1367	# 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.	1368	# 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	1369	# failure to comply are harmless and result in display errors
1093	# at worst.	1370	# at worst.
1094	sub conn::flood_fill {	1371	sub conn::flood_fill {
1095	my ($self, $gx, $gy, $path, $hash, $flags) = @_;	1372	my ($self, $block, $gx, $gy, $path, $hash, $flags) = @_;
1096		1373
1097	# the server does not allow map paths > 6	1374	# the server does not allow map paths > 6
1098	return if 7 <= length $path;	1375	return if 7 <= length $path;
1099		1376
1100	my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};	1377	my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
1101		1378
1102	for (	1379	for (
1103	[1, 0, -1],	1380	[1, 3, 0, -1],
1104	[2, 1, 0],	1381	[2, 4, 1, 0],
1105	[3, 0, 1],	1382	[3, 1, 0, 1],
1106	[4, -1, 0],	1383	[4, 2, -1, 0],
1107	) {	1384	) {
1108	my ($tile, $dx, $dy) = @$_;	1385	my ($tile, $tile2, $dx, $dy) = @$_;
		1386
		1387	next if $block & (1 << $tile);
		1388	my $block = $block | (1 << $tile2);
1109		1389
1110	my $gx = $gx + $dx;	1390	my $gx = $gx + $dx;
1111	my $gy = $gy + $dy;	1391	my $gy = $gy + $dy;
1112		1392
1113	next unless $flags & (1 << ($tile - 1));	1393	next unless $flags & (1 << ($tile - 1));
…		…
1115		1395
1116	my $neigh = $self->{neigh_map}{$hash} ||= [];	1396	my $neigh = $self->{neigh_map}{$hash} ||= [];
1117	if (my $info = $neigh->[$tile]) {	1397	if (my $info = $neigh->[$tile]) {
1118	my ($flags, $x, $y, $w, $h, $hash) = @$info;	1398	my ($flags, $x, $y, $w, $h, $hash) = @$info;
1119		1399
1120	$self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags)	1400	$self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
1121	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;	1401	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1122		1402
1123	} else {	1403	} else {
1124	$self->send_mapinfo ("spatial $path$tile", sub {	1404	$self->send_mapinfo ("spatial $path$tile", sub {
1125	my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;	1405	my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
1126		1406
1127	return if $mode ne "spatial";	1407	return if $mode ne "spatial";
1128		1408
1129	$x += $MAP->ox;	1409	$x += $MAP->ox;
1130	$y += $MAP->oy;	1410	$y += $MAP->oy;
1131		1411
1132	$self->load_map ($hash, $x, $y)	1412	$self->load_map ($hash, $x, $y)
1133	unless $self->{neigh_map}{$hash}[5]++;#d#	1413	unless $self->{neigh_map}{$hash}[5]++;#d#
1134		1414
1135	$neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];	1415	$neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
1136		1416
1137	$self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags)	1417	$self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
1138	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;	1418	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1139	});	1419	});
1140	}	1420	}
1141	}	1421	}
1142	}	1422	}
…		…
1155	$ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,	1435	$ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
1156	$ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,	1436	$ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
1157	];	1437	];
1158		1438
1159	delete $self->{neigh_grid};	1439	delete $self->{neigh_grid};
1160	$self->flood_fill (0, 0, "", $hash, $flags);
1161		1440
1162	$x += $ox;	1441	$x += $ox;
1163	$y += $oy;	1442	$y += $oy;
1164		1443
1165	$self->{map_info} = [$hash, $x, $y, $w, $h];	1444	$self->{map_info} = [$hash, $x, $y, $w, $h];
1166		1445
1167	my $map = $self->{map_info}[0];
1168	$map =~ s/^.*?\/([^\/]+)$/\1/;	1446	(my $map = $hash) =~ s/^.*?\/([^\/]+)$/\1/;
1169	$STATWIDS->{map}->set_text ("Map: " . $map);	1447	$STATWIDS->{map}->set_text ("Map: " . $map);
1170		1448
1171	$self->load_map ($hash, $x, $y);	1449	$self->load_map ($hash, $x, $y);
		1450	$self->flood_fill (0, 0, 0, "", $hash, $flags);
1172	}	1451	}
1173		1452
1174	sub conn::face_find {	1453	sub conn::face_find {
1175	my ($self, $facenum, $face) = @_;	1454	my ($self, $facenum, $face) = @_;
1176		1455
…		…
1178		1457
1179	my $id = $FACEMAP->get ($hash);	1458	my $id = $FACEMAP->get ($hash);
1180		1459
1181	unless ($id) {	1460	unless ($id) {
1182	# create new id for face	1461	# create new id for face
1183	# i love transactions	1462	# I love transactions
1184	for (1..100) {	1463	for (1..100) {
1185	my $txn = $CFClient::DB_ENV->txn_begin;	1464	my $txn = $CFClient::DB_ENV->txn_begin;
1186	my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);	1465	my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);
1187	if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {	1466	if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
1188	$id++;	1467	$id = ($id || 16) + 1;
1189	if ($FACEMAP->put (id => $id) == 0	1468	if ($FACEMAP->put (id => $id) == 0
1190	&& $FACEMAP->put ($hash => $id) == 0) {	1469	&& $FACEMAP->put ($hash => $id) == 0) {
1191	$txn->txn_commit;	1470	$txn->txn_commit;
1192		1471
1193	goto gotid;	1472	goto gotid;
…		…
1201		1480
1202	gotid:	1481	gotid:
1203	$face->{id} = $id;	1482	$face->{id} = $id;
1204	$MAP->set_face ($facenum => $id);	1483	$MAP->set_face ($facenum => $id);
1205	$self->{faceid}[$facenum] = $id;#d#	1484	$self->{faceid}[$facenum] = $id;#d#
		1485
1206	$TILECACHE->get ($id)	1486	$TILECACHE->get ($id) || do {
		1487	my $tex = $self->{noface};
		1488	$MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
		1489	undef
		1490	};
1207	}	1491	}
1208		1492
1209	sub conn::face_update {	1493	sub conn::face_update {
1210	my ($self, $facenum, $face) = @_;	1494	my ($self, $facenum, $face) = @_;
1211		1495
…		…
1254	title => "Query",	1538	title => "Query",
1255	child => my $vbox = new CFClient::UI::VBox;	1539	child => my $vbox = new CFClient::UI::VBox;
1256		1540
1257	$vbox->add (new CFClient::UI::Label	1541	$vbox->add (new CFClient::UI::Label
1258	max_w => $::WIDTH * 0.4,	1542	max_w => $::WIDTH * 0.4,
		1543	ellipsise => 0,
1259	text => $prompt);	1544	text => $prompt);
1260		1545
1261	if ($flags & Crossfire::Protocol::CS_QUERY_YESNO) {	1546	if ($flags & Crossfire::Protocol::CS_QUERY_YESNO) {
1262	$vbox->add (my $hbox = new CFClient::HBox);	1547	$vbox->add (my $hbox = new CFClient::HBox);
1263	$hbox->add (new CFClient::Button	1548	$hbox->add (new CFClient::Button
…		…
1271	$hbox->add (new CFClient::Button	1556	$hbox->add (new CFClient::Button
1272	text => "Yes",	1557	text => "Yes",
1273	connect_activate => sub {	1558	connect_activate => sub {
1274	$self->send ("reply y");	1559	$self->send ("reply y");
1275	$dialog->destroy;	1560	$dialog->destroy;
1276	$MAPWIDGET->focus_in;
1277	},	1561	},
1278	);	1562	);
1279		1563
1280	$dialog->focus_in;	1564	$dialog->focus_in;
1281		1565
…		…
1283	$dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";	1567	$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	1568	$vbox->add (my $entry = new CFClient::UI::Entry
1285	connect_changed => sub {	1569	connect_changed => sub {
1286	$self->send ("reply $_[1]");	1570	$self->send ("reply $_[1]");
1287	$dialog->destroy;	1571	$dialog->destroy;
1288	$MAPWIDGET->focus_in;
1289	},	1572	},
1290	);	1573	);
1291		1574
1292	$entry->focus_in;	1575	$entry->focus_in;
1293		1576
…		…
1297	$vbox->add (my $entry = new CFClient::UI::Entry	1580	$vbox->add (my $entry = new CFClient::UI::Entry
1298	$flags & Crossfire::Protocol::CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (),	1581	$flags & Crossfire::Protocol::CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (),
1299	connect_activate => sub {	1582	connect_activate => sub {
1300	$self->send ("reply $_[1]");	1583	$self->send ("reply $_[1]");
1301	$dialog->destroy;	1584	$dialog->destroy;
1302	$MAPWIDGET->focus_in;
1303	},	1585	},
1304	);	1586	);
1305		1587
1306	$entry->focus_in;	1588	$entry->focus_in;
1307	}	1589	}
1308		1590
1309	$dialog->show;	1591	$dialog->show_centered;
1310	}	1592	}
1311		1593
1312	sub conn::drawinfo {	1594	sub conn::drawinfo {
1313	my ($self, $color, $text) = @_;	1595	my ($self, $color, $text) = @_;
1314		1596
…		…
1326	[0.55, 0.41, 0.13],	1608	[0.55, 0.41, 0.13],
1327	[0.99, 0.77, 0.26],	1609	[0.99, 0.77, 0.26],
1328	[0.74, 0.65, 0.41],	1610	[0.74, 0.65, 0.41],
1329	);	1611	);
1330		1612
		1613	my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
		1614
		1615	$text = CFClient::UI::Label::escape $text;
		1616	$text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g;
		1617	$text =~ s/\[color=(.*?)\](.*?)\[\/color\]/<span foreground='\1'>\2<\/span>/g;
		1618
1331	$LOGVIEW->add_paragraph ($color[$color], $text);	1619	$LOGVIEW->add_paragraph ($color[$color],
		1620	join "\n", map "$time $_", split /\n/, $text);
		1621
		1622	$STATUSBOX->add ($text,
		1623	group => $text,
		1624	fg => $color[$color],
		1625	timeout => 60,
		1626	tooltip_font => $::FONT_FIXED,
		1627	);
		1628	}
		1629
		1630	sub conn::drawextinfo {
		1631	my ($self, $color, $type, $subtype, $message) = @_;
		1632
		1633	$self->drawinfo ($color, $message);
1332	}	1634	}
1333		1635
1334	sub conn::spell_add {	1636	sub conn::spell_add {
1335	my ($self, $spell) = @_;	1637	my ($self, $spell) = @_;
1336		1638
1337	# TODO	1639	# TODO
1338	# create a widget dynamically, using spell face (CF::Protocol downloads them)	1640	# create a widget dynamically, using spell face (CF::Protocol downloads them)
1339	$MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message});	1641	$MAPWIDGET->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1340	$MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message});	1642	$MAPWIDGET->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1341	}	1643	}
1342		1644
1343	sub conn::spell_delete {	1645	sub conn::spell_delete {
1344	my ($self, $spell) = @_;	1646	my ($self, $spell) = @_;
1345	}	1647	}
1346		1648
1347	sub conn::addme_success {	1649	sub conn::addme_success {
1348	my ($self) = @_;	1650	my ($self) = @_;
1349		1651
		1652	$self->send ("command output-sync $CFG->{output_sync}");
		1653	$self->send ("command output-count $CFG->{output_count}");
		1654
		1655	my $parser = new Pod::POM;
		1656	my $pod = $parser->parse_file (CFClient::find_rcfile "pod/skill_help.pod");
		1657
		1658	my %skill_tooltip;
		1659
		1660	for my $head2 ($pod->head2) {
		1661	$skill_tooltip{$head2->title} = CFClient::pod_to_pango $head2->content;
		1662	}
		1663
1350	for my $skill (values %{$self->{skill_info}}) {	1664	for my $skill (values %{$self->{skill_info}}) {
1351	$MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'");	1665	$MAPWIDGET->add_command ("ready_skill $skill",
1352	$MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'");	1666	(CFClient::UI::Label::escape "Ready the skill '$skill'\n\n")
		1667	. $skill_tooltip{$skill});
		1668	$MAPWIDGET->add_command ("use_skill $skill",
		1669	(CFClient::UI::Label::escape "Immediately use the skill '$skill'\n\n")
		1670	. $skill_tooltip{$skill});
1353	}	1671	}
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	}	1672	}
1360		1673
1361	sub conn::eof {	1674	sub conn::eof {
		1675	$MAPWIDGET->clr_commands;
		1676
1362	stop_game;	1677	stop_game;
1363	}	1678	}
1364		1679
1365	sub update_floorbox {	1680	sub update_floorbox {
1366	$CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {	1681	$CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
1367	return unless $CONN;	1682	return unless $CONN;
1368		1683
1369	$FLOORBOX->clear;	1684	$FLOORBOX->clear;
1370	$FLOORBOX->add (new CFClient::UI::Empty expand => 1);	1685	$FLOORBOX->add (new CFClient::UI::Empty expand => 1);
1371		1686
1372	# we basically have to use the same sorting as everybody else	1687	my $count = 7;
1373	$FLOORBOX->add (	1688	for (@{ $CONN->{container}{0} }) {
		1689	if (--$count) {
1374	map +(new CFClient::UI::InventoryItem item => $_),	1690	$FLOORBOX->add (new CFClient::UI::InventoryItem item => $_);
1375	@{ $CONN->{container}{0} }	1691	} else {
		1692	$FLOORBOX->add (new CFClient::UI::Label text => "More...");
		1693	last;
		1694	}
1376	);	1695	}
1377	});	1696	});
1378		1697
1379	$WANT_REFRESH++;	1698	$WANT_REFRESH++;
1380	}	1699	}
1381		1700
1382	sub conn::container_add {	1701	sub conn::container_add {
1383	my ($self, $tag, $items) = @_;	1702	my ($self, $tag, $items) = @_;
1384		1703
1385	update_floorbox if $tag == 0;	1704	#d# print "container_add: container $tag ($self->{player}{tag})\n";
1386		1705
		1706	if ($tag == 0) {
		1707	update_floorbox;
		1708	$OPENCONT = 0;
		1709	$INVR_LBL->set_text ("Floor");
		1710	$INVR->set_items ($self->{container}{0});
		1711	} elsif ($tag == $self->{player}{tag}) {
		1712	$INVR_LBL->set_text ("Player");
1387	$INV->set_items ($self->{container}{$self->{player}{tag}})	1713	$INV->set_items ($self->{container}{$self->{player}{tag}})
1388	if $tag == $self->{player}{tag};	1714	} else {
		1715	$OPENCONT = $tag;
		1716	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
		1717	$INVR->set_items ($self->{container}{$tag});
		1718	}
1389		1719
1390	# $self-<{player}{tag} => player inv	1720	# $self-<{player}{tag} => player inv
1391	#use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};	1721	#use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1392	}	1722	}
1393		1723
1394	sub conn::container_clear {	1724	sub conn::container_clear {
1395	my ($self, $tag) = @_;	1725	my ($self, $tag) = @_;
1396		1726
1397	update_floorbox if $tag == 0;	1727	#d# print "container_clear: container $tag ($self->{player}{tag})\n";
1398		1728
		1729	if ($tag == 0) {
		1730	update_floorbox;
		1731	$OPENCONT = 0;
		1732	$INVR_LBL->set_text ("Floor");
		1733	$INVR->set_items ($self->{container}{0});
		1734	} elsif ($tag == $self->{player}{tag}) {
		1735	$INVR_LBL->set_text ("Player");
1399	$INV->set_items ($self->{container}{$tag})	1736	$INV->set_items ($self->{container}{$tag})
1400	if $tag == $self->{player}{tag};	1737	} else {
		1738	$OPENCONT = $tag;
		1739	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
		1740	$INVR->set_items ($self->{container}{$tag});
		1741	}
1401		1742
1402	# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};	1743	# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1403	}	1744	}
1404		1745
1405	sub conn::item_delete {	1746	sub conn::item_delete {
1406	my ($self, @items) = @_;	1747	my ($self, @items) = @_;
1407		1748
1408	for (@items) {	1749	for (@items) {
1409	update_floorbox if $_->{container} == 0;	1750	#d# print "item_delete: $_->{tag} from $_->{container} ($self->{player}{tag})\n";
1410		1751
		1752	if ($_->{container} == 0) {
		1753	update_floorbox;
		1754	$OPENCONT = 0;
		1755	$INVR_LBL->set_text ("Floor");
		1756	$INVR->set_items ($self->{container}{0});
		1757	} elsif ($_->{container} == $self->{player}{tag}) {
		1758	$INVR_LBL->set_text ("Player");
		1759	$INV->set_items ($self->{container}{$self->{player}{tag}})
		1760	} else {
		1761	$OPENCONT = $_->{container};
		1762	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1411	$INV->set_items ($self->{container}{$_->{container}})	1763	$INVR->set_items ($self->{container}{$_->{container}});
1412	if $_->{container} == $self->{player}{tag};	1764	}
1413	}	1765	}
1414	}	1766	}
1415		1767
1416	sub conn::item_update {	1768	sub conn::item_update {
1417	my ($self, $item) = @_;	1769	my ($self, $item) = @_;
1418		1770
1419	update_floorbox if $item->{container} == 0;	1771	#d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($OPENCONT)\n";
1420		1772
		1773	if ($item->{tag} == $OPENCONT && not ($item->{flags} & Crossfire::Protocol::F_OPEN)) {
		1774	$OPENCONT = 0;
		1775	$INVR_LBL->set_text ("Floor");
		1776	$INVR->set_items ($self->{container}{0});
		1777
		1778	$item->{widget}->update_item
		1779	if $item->{widget};
		1780	} else {
		1781	if ($item->{container} == 0) {
		1782	update_floorbox;
		1783	$OPENCONT = 0;
		1784	$INVR_LBL->set_text ("Floor");
		1785	$INVR->set_items ($self->{container}{0});
		1786	} elsif ($item->{container} == $self->{player}{tag}) {
1421	$INV->set_items ($self->{container}{$item->{container}})	1787	$INV->set_items ($self->{container}{$item->{container}})
1422	if $item->{container} == $self->{player}{tag};	1788	}
		1789	}
1423	}	1790	}
1424		1791
1425	%SDL_CB = (	1792	%SDL_CB = (
1426	CFClient::SDL_QUIT => sub {	1793	CFClient::SDL_QUIT => sub {
1427	Event::unloop -1;	1794	Event::unloop -1;
1428	},	1795	},
1429	CFClient::SDL_VIDEORESIZE => sub {	1796	CFClient::SDL_VIDEORESIZE => sub {
1430	},	1797	},
1431	CFClient::SDL_VIDEOEXPOSE => sub {	1798	CFClient::SDL_VIDEOEXPOSE => sub {
1432	$WANT_REFRESH++;	1799	CFClient::UI::full_refresh;
1433	},	1800	},
1434	CFClient::SDL_ACTIVEEVENT => sub {	1801	CFClient::SDL_ACTIVEEVENT => sub {
1435	# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#	1802	# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
1436	},	1803	},
1437	CFClient::SDL_KEYDOWN => sub {	1804	CFClient::SDL_KEYDOWN => sub {
…		…
1473	sdl_mode => 0,	1840	sdl_mode => 0,
1474	width => 640,	1841	width => 640,
1475	height => 480,	1842	height => 480,
1476	fullscreen => 0,	1843	fullscreen => 0,
1477	fast => 0,	1844	fast => 0,
1478	map_scale => 0.5,	1845	map_scale => 1,
1479	fow_enable => 1,	1846	fow_enable => 1,
1480	fow_intensity => 0.45,	1847	fow_intensity => 0.45,
1481	fow_smooth => 0,	1848	fow_smooth => 0,
1482	gui_fontsize => 1,	1849	gui_fontsize => 1,
1483	log_fontsize => 1,	1850	log_fontsize => 1,
…		…
1488	host => "crossfire.schmorp.de",	1855	host => "crossfire.schmorp.de",
1489	say_command => 'say',	1856	say_command => 'say',
1490	audio_enable => 1,	1857	audio_enable => 1,
1491	bgm_enable => 1,	1858	bgm_enable => 1,
1492	bgm_volume => 0.25,	1859	bgm_volume => 0.25,
		1860	output_sync => 1,
		1861	output_count => 1,
1493	);	1862	);
1494		1863
1495	while (my ($k, $v) = each %DEF_CFG) {	1864	while (my ($k, $v) = each %DEF_CFG) {
1496	$CFG->{$k} = $v unless exists $CFG->{$k};	1865	$CFG->{$k} = $v unless exists $CFG->{$k};
1497	}	1866	}
…		…
1518	DejaVuSansMono-BoldOblique.ttf	1887	DejaVuSansMono-BoldOblique.ttf
1519	);	1888	);
1520		1889
1521	CFClient::add_font $_ for @fonts;	1890	CFClient::add_font $_ for @fonts;
1522		1891
		1892	CFClient::pango_init;
		1893
1523	$FONT_PROP = new_from_file CFClient::Font $fonts[0];	1894	$FONT_PROP = new_from_file CFClient::Font $fonts[0];
1524	$FONT_FIXED = new_from_file CFClient::Font $fonts[1];	1895	$FONT_FIXED = new_from_file CFClient::Font $fonts[1];
1525		1896
1526	$FONT_PROP->make_default;	1897	$FONT_PROP->make_default;
1527	}	1898	}
1528		1899
		1900	# compare mono (ft) vs. rgba (cairo)
		1901	# ft - 1.8s, cairo 3s, even in alpha-only mode
		1902	# for my $rgba (0..1) {
		1903	# my $t1 = Time::HiRes::time;
		1904	# for (1..1000) {
		1905	# my $layout = CFClient::Layout->new ($rgba);
		1906	# $layout->set_text ("hallo" x 100);
		1907	# $layout->render;
		1908	# }
		1909	# my $t2 = Time::HiRes::time;
		1910	# warn $t2-$t1;
		1911	# }
		1912
1529	video_init;	1913	video_init;
1530	audio_init;	1914	audio_init;
1531	}	1915	}
1532		1916
1533	Event::loop;	1917	Event::loop;
1534		1918
1535	END { CFClient::SDL_Quit }	1919	END { CFClient::SDL_Quit }
1536		1920
		1921	=head1 NAME
		1922
1537	=head1 pclient - Crossfire+ and Crossfire game client	1923	pclient - A Crossfire+ and Crossfire game client
1538		1924
1539	Pclient is a Crossfire+ and Crossfire game client.	1925	=head1 SYNOPSIS
1540		1926
1541	=head2 Features	1927	Just run it - no commandline arguments are supported.
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		1928
1571	=head1 USAGE	1929	=head1 USAGE
1572		1930
1573	=head2 The Map	1931	Pclient utilises OpenGL for all UI elements and the game. It is supposed to be used
1574		1932	fullscreen and interactively.
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		1933
1637	=head1 AUTHOR	1934	=head1 AUTHOR
1638		1935
1639	Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>	1936	Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
1640		1937

Diff Legend

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