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.176 by root, Mon Apr 24 10:19:40 2006 UTC vs.
Revision 1.233 by root, Mon May 22 01:28:41 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
…		…
36		37
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	$SIG{__DIE__} = sub { CFClient::fatal "$_[0]"; exit 1 };	42	$Event::DIED = sub {
		43	# TODO: display dialog box or so
		44	CFClient::error $_[1];
		45	};
		46
		47	#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#
42		48
43	our $VERSION = '0.1';	49	our $VERSION = '0.1';
44		50
45	my $MAX_FPS = 60;	51	my $MAX_FPS = 60;
46	my $MIN_FPS = 5; # unused as of yet	52	my $MIN_FPS = 5; # unused as of yet
…		…
55	our $NOW;	61	our $NOW;
56		62
57	our $CFG;	63	our $CFG;
58	our $CONN;	64	our $CONN;
59	our $FAST; # fast, low-quality mode, possibly useful for software-rendering	65	our $FAST; # fast, low-quality mode, possibly useful for software-rendering
		66
		67	our $WANT_REFRESH;
		68	our $CAN_REFRESH;
60		69
61	our @SDL_MODES;	70	our @SDL_MODES;
62	our $WIDTH;	71	our $WIDTH;
63	our $HEIGHT;	72	our $HEIGHT;
64	our $FULLSCREEN;	73	our $FULLSCREEN;
…		…
66		75
67	our $FONT_PROP;	76	our $FONT_PROP;
68	our $FONT_FIXED;	77	our $FONT_FIXED;
69		78
70	our $MAP;	79	our $MAP;
		80	our $MAPMAP;
71	our $MAPWIDGET;	81	our $MAPWIDGET;
72	our $BUTTONBAR;	82	our $BUTTONBAR;
73	our $LOGVIEW;	83	our $LOGVIEW;
74	our $CONSOLE;	84	our $CONSOLE;
75	our $METASERVER;	85	our $METASERVER;
		86	our $LOGIN_BUTTON;
76		87
77	our $FLOORBOX;	88	our $FLOORBOX;
78	our $GAUGES;	89	our $GAUGES;
79	our $STATWIDS;	90	our $STATWIDS;
80		91
…		…
84	our $SDL_MIXER;	95	our $SDL_MIXER;
85	our @SOUNDS; # event => file mapping	96	our @SOUNDS; # event => file mapping
86	our %AUDIO_CHUNKS; # audio files	97	our %AUDIO_CHUNKS; # audio files
87		98
88	our $ALT_ENTER_MESSAGE;	99	our $ALT_ENTER_MESSAGE;
89	our $STATUS_LINE;	100	our $STATUSBOX;
90	our $DEBUG_STATUS;	101	our $DEBUG_STATUS;
91		102
		103	our $INVWIN;
		104	our $INV;
		105	our $INVR;
		106	our $INVR_LBL;
		107	our $OPENCONT;
		108
92	sub status {	109	sub status {
93	$STATUS_LINE->set_text ($_[0]);	110	$STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 20, fg => [1, 1, 0, 1]);
94	$STATUS_LINE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $STATUS_LINE->{h});
95	}	111	}
96		112
97	sub debug {	113	sub debug {
98	$DEBUG_STATUS->set_text ($_[0]);	114	$DEBUG_STATUS->set_text ($_[0]);
99	$DEBUG_STATUS->move ($WIDTH - $DEBUG_STATUS->{w}, 0, $DEBUG_STATUS->{w}, $DEBUG_STATUS->{h});	115	my ($w, $h) = $DEBUG_STATUS->size_request;
		116	$DEBUG_STATUS->move ($WIDTH - $w, 0);
100	}	117	}
101		118
102	sub start_game {	119	sub start_game {
103	status "logging in...";	120	status "logging in...";
104		121
105	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;	122	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
106		123
107	$MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";	124	$MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";
108
109	$MAP = new CFClient::Map $mapsize, $mapsize;	125	$MAP = new CFClient::Map $mapsize, $mapsize;
110		126
111	my ($host, $port) = split /:/, $CFG->{host};	127	my ($host, $port) = split /:/, $CFG->{host};
112		128
113	$CONN = new conn	129	$CONN = eval {
		130	new conn
114	host => $host,	131	host => $host,
115	port => $port || 13327,	132	port => $port || 13327,
116	user => $CFG->{user},	133	user => $CFG->{user},
117	pass => $CFG->{password},	134	pass => $CFG->{password},
118	mapw => $mapsize,	135	mapw => $mapsize,
119	maph => $mapsize,	136	maph => $mapsize,
		137	;
120	;	138	};
121		139
122	status "login successful";	140	if ($CONN) {
123
124	CFClient::lowdelay fileno $CONN->{fh};	141	CFClient::lowdelay fileno $CONN->{fh};
		142
		143	$LOGIN_BUTTON->set_text ("Logout");
		144	status "login successful";
		145
		146	$BUTTONBAR->{children}[1]->emit ("activate")
		147	if $BUTTONBAR->{children}[1]->{state};
		148
		149	} else {
		150	status "unable to connect";
		151	stop_game();
		152	}
125	}	153	}
126		154
127	sub stop_game {	155	sub stop_game {
		156	return unless $CONN;
		157
		158	status "connection closed";
		159	$LOGIN_BUTTON->set_text ("Login");
		160	$CONN->destroy;
		161	$CONN = 0; # false, does not autovivify
		162
		163	$BUTTONBAR->{children}[1]->emit ("activate")
		164	unless $BUTTONBAR->{children}[1]->{state};
		165
		166	undef $MAPCACHE;
128	undef $CONN;	167	undef $MAP;
129	}	168	}
130		169
131	sub client_setup {	170	sub client_setup {
132	my $dialog = new CFClient::UI::FancyFrame	171	my $dialog = new CFClient::UI::FancyFrame
133	title => "Client Setup",	172	title => "Client Setup",
…		…
135	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);	174	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
136		175
137	$table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");	176	$table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");
138	$table->add (1, 0, my $hbox = new CFClient::UI::HBox);	177	$table->add (1, 0, my $hbox = new CFClient::UI::HBox);
139		178
140	$hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1]);	179	$hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 1, 1]);
141	$hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");	180	$hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");
142		181
143	$mode_slider->connect (changed => sub {	182	$mode_slider->connect (changed => sub {
144	my ($self, $value) = @_;	183	my ($self, $value) = @_;
145		184
…		…
170	}	209	}
171	);	210	);
172		211
173	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");	212	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
174	$table->add (1, $row++, new CFClient::UI::Slider	213	$table->add (1, $row++, new CFClient::UI::Slider
175	range => [$CFG->{map_scale}, 0.25, 2, 0.05],	214	range => [$CFG->{map_scale}, 0.25, 2, 0.05, 0.05],
176	tooltip => "Enlarge or shrink the displayed map",	215	tooltip => "Enlarge or shrink the displayed map",
177	connect_changed => sub {	216	connect_changed => sub {
178	my ($self, $value) = @_;	217	my ($self, $value) = @_;
179	$CFG->{map_scale} = 0.05 * int $value / 0.05;	218	$CFG->{map_scale} = $value;
180	}	219	}
181	);	220	);
182		221
183	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");	222	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
184	$table->add (1, $row++, new CFClient::UI::CheckBox	223	$table->add (1, $row++, new CFClient::UI::CheckBox
…		…
211	}	250	}
212	);	251	);
213		252
214	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");	253	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
215	$table->add (1, $row++, new CFClient::UI::Slider	254	$table->add (1, $row++, new CFClient::UI::Slider
216	range => [$CFG->{gui_fontsize}, 0.5, 2, 0.1],	255	range => [$CFG->{gui_fontsize}, 0.5, 2, 0.1, 0.1],
217	tooltip => "The font size used by most GUI elements",	256	tooltip => "The font size used by most GUI elements",
218	connect_changed => sub {	257	connect_changed => sub { $CFG->{gui_fontsize} = $_[1] },
219	$CFG->{gui_fontsize} = 0.1 * int $_[1] * 10;
220	# $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
221	}
222	);	258	);
223		259
224	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Server Log Fontsize");	260	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Server Log Fontsize");
225	$table->add (1, $row++, new CFClient::UI::Slider	261	$table->add (1, $row++, new CFClient::UI::Slider
226	range => [$CFG->{log_fontsize}, 0.5, 2, 0.1],	262	range => [$CFG->{log_fontsize}, 0.5, 2, 0.1, 0.1],
227	tooltip => "The font size used by the server log window only",	263	tooltip => "The font size used by the server log window only",
228	connect_changed => sub {	264	connect_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]) },
229	$LOGVIEW->set_fontsize ($CFG->{log_fontsize} = 0.1 * int $_[1] * 10);
230	}
231	);	265	);
232		266
233	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");	267	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
234		268
235	$table->add (1, $row++, new CFClient::UI::Slider	269	$table->add (1, $row++, new CFClient::UI::Slider
236	range => [$CFG->{stat_fontsize}, 0.5, 2, 0.1],	270	range => [$CFG->{stat_fontsize}, 0.5, 2, 0.1, 0.1],
237	tooltip => "The font size used by the statistics window only",	271	tooltip => "The font size used by the statistics window only",
238	connect_changed => sub {	272	connect_changed => sub {
239	$CFG->{stat_fontsize} = 0.1 * int $_[1] * 10;	273	$CFG->{stat_fontsize} = $_[1];
240	&set_stats_window_fontsize;	274	&set_stats_window_fontsize;
241	}	275	}
242	);	276	);
243		277
244	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");	278	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
245	$table->add (1, $row++, new CFClient::UI::Slider	279	$table->add (1, $row++, new CFClient::UI::Slider
246	range => [$CFG->{gauge_size}, 0.2, 0.8, 0.02],	280	range => [$CFG->{gauge_size}, 0.2, 0.8, 0.02],
247	tooltip => "Adjust the size of the stats gauges at the bottom right",	281	tooltip => "Adjust the size of the stats gauges at the bottom right",
248	connect_changed => sub {	282	connect_changed => sub {
249	$CFG->{gauge_size} = $_[1];	283	$CFG->{gauge_size} = $_[1];
250	my $h = int $HEIGHT * $CFG->{gauge_size};	284	$GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
251	$GAUGES->{win}->set_size ($WIDTH, $h);
252	$GAUGES->{win}->move (0, $HEIGHT - $h);
253	}	285	}
254	);	286	);
255		287
256	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");	288	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
257	$table->add (1, $row++, new CFClient::UI::Slider	289	$table->add (1, $row++, new CFClient::UI::Slider
258	range => [$CFG->{gauge_fontsize}, 0.5, 2.0, 0.1],	290	range => [$CFG->{gauge_fontsize}, 0.5, 2.0, 0.1, 0.1],
259	tooltip => "Adjusts the fontsize of the gauges at the bottom right",	291	tooltip => "Adjusts the fontsize of the gauges at the bottom right",
260	connect_changed => sub {	292	connect_changed => sub {
261	$CFG->{gauge_fontsize} = 0.1 * int $_[1] * 10;	293	$CFG->{gauge_fontsize} = $_[1];
262	&set_gauge_window_fontsize;	294	&set_gauge_window_fontsize;
263	}	295	}
264	);	296	);
265		297
266	$table->add (1, $row++, new CFClient::UI::Button	298	$table->add (1, $row++, new CFClient::UI::Button
…		…
309	audio_shutdown ();	341	audio_shutdown ();
310	audio_init ();	342	audio_init ();
311	}	343	}
312	);	344	);
313		345
		346	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Communication cmd");
		347	$table->add (1, $row++, my $saycmd = new CFClient::UI::Entry
		348	text => $CFG->{say_command},
		349	tooltip => "This is the command that will be used if you write a line in the message window entry. "
		350	."Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
		351	."But you could also set it to 'tell <playername>' to only chat with that user.",
		352	connect_changed => sub {
		353	my ($self, $value) = @_;
		354	$CFG->{say_command} = $value;
		355	}
		356	);
		357
314	$dialog	358	$dialog
315	}	359	}
316		360
317	sub set_stats_window_fontsize {	361	sub set_stats_window_fontsize {
318	for (values %{$STATWIDS}) {	362	for (values %{$STATWIDS}) {
…		…
328	# local $GAUGES->{win}{parent};#d#	372	# local $GAUGES->{win}{parent};#d#
329	# use PApp::Util; open D, ">:utf8", "d"; print D PApp::Util::dumpval $GAUGES->{win}; close D;	373	# use PApp::Util; open D, ">:utf8", "d"; print D PApp::Util::dumpval $GAUGES->{win}; close D;
330	}	374	}
331		375
332	sub make_gauge_window {	376	sub make_gauge_window {
333	my $gh = int ($HEIGHT * $CFG->{gauge_size});	377	my $gh = int $HEIGHT * $CFG->{gauge_size};
334	# my $gw = int ($WIDTH * $CFG->{gauge_w_size});
335		378
336	my $win = new CFClient::UI::Frame (	379	my $win = new CFClient::UI::Frame (
337	y => $HEIGHT - $gh, x => 0, user_w => $WIDTH, user_h => $gh	380	req_y => -1,
		381	user_w => $WIDTH,
		382	user_h => $gh,
338	);	383	);
		384
339	$win->add (my $hbox = new CFClient::UI::HBox	385	$win->add (my $hbox = new CFClient::UI::HBox
340	children => [	386	children => [
341	(new CFClient::UI::HBox expand => 1),	387	(new CFClient::UI::HBox expand => 1),
342	($FLOORBOX = new CFClient::UI::VBox),	388	(new CFClient::UI::VBox children => [
		389	(new CFClient::UI::Empty expand => 1),
		390	(new CFClient::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new CFClient::UI::VBox)),
		391	]),
343	(my $vbox = new CFClient::UI::VBox),	392	(my $vbox = new CFClient::UI::VBox),
344	],	393	],
345	);	394	);
346		395
347	$vbox->add (new CFClient::UI::HBox	396	$vbox->add (new CFClient::UI::HBox
…		…
351	(my $hb = new CFClient::UI::HBox),	400	(my $hb = new CFClient::UI::HBox),
352	],	401	],
353	);	402	);
354		403
355	$hb->add (my $hg = new CFClient::UI::Gauge type => 'hp',	404	$hb->add (my $hg = new CFClient::UI::Gauge type => 'hp',
356	tooltip => "Health points - depletes when you get wounded, refills when you heal or idle");	405	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.");
357	$hb->add (my $mg = new CFClient::UI::Gauge type => 'mana',	406	$hb->add (my $mg = new CFClient::UI::Gauge type => 'mana',
358	tooltip => "Spell points - deplete when you cast wizard spells, refills when you idle");	407	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.");
359	$hb->add (my $gg = new CFClient::UI::Gauge type => 'grace',	408	$hb->add (my $gg = new CFClient::UI::Gauge type => 'grace',
360	tooltip => "Grace points - deplete when you cast priest spells, refills when you pray");	409	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.");
361	$hb->add (my $fg = new CFClient::UI::Gauge type => 'food',	410	$hb->add (my $fg = new CFClient::UI::Gauge type => 'food',
362	tooltip => "Food - depletes with time, faster when you heal or build mana, refills when you eat healthy food");	411	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.");
363		412
364	$vbox->add (my $exp = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,	413	$vbox->add (my $exp = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
365	tooltip => "Experience points and level - increases when you kill monsters or successfully use skills");	414	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.");
366	$vbox->add (my $rng = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,	415	$vbox->add (my $rng = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
367	tooltip => "Ranged attack - how you attack when you press shift-cursor (spell, skill, weapon etc.)");	416	tooltip => "Ranged attack - how you attack when you press shift-cursor (spell, skill, weapon etc.)");
368		417
369	$GAUGES = {	418	$GAUGES = {
370	exp => $exp, win => $win, range => $rng,	419	exp => $exp, win => $win, range => $rng,
…		…
375		424
376	$win	425	$win
377	}	426	}
378		427
379	sub make_stats_window {	428	sub make_stats_window {
380	my $tgw = new CFClient::UI::FancyFrame (x => $WIDTH * 2/5, y => 0, title => "Stats");	429	my $tgw = new CFClient::UI::FancyFrame x => $WIDTH * 2/5, y => 0, title => "Stats";
381		430
382	$tgw->add (my $vb = new CFClient::UI::VBox);	431	$tgw->add (new CFClient::UI::Window child => my $vb = new CFClient::UI::VBox);
383	$vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1);	432	$vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1);
384	$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);
385		434
386	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);	435	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
387		436
388	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);	437	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);
389		438
390	my $black = [0, 0, 0];	439	my $black = [0, 0, 0];
391		440
392	$tbl->add (0, 0, $STATWIDS->{st_str} = new CFClient::UI::Label valign => 0, align => +1, template => "30");	441	for (
393	$tbl->add (0, 1, $STATWIDS->{st_dex} = new CFClient::UI::Label valign => 0, align => +1, template => "30");	442	[0, 0, st_str => "Str", 30, "Physical Strength, determines damage dealt with weapons, how much you can carry, and how often you can attack"],
394	$tbl->add (0, 2, $STATWIDS->{st_con} = new CFClient::UI::Label valign => 0, align => +1, template => "30");	443	[0, 1, st_dex => "Dex", 30, "Dexterity, your physical agility. Determines chance of being hit and affects armor class and speed"],
395	$tbl->add (0, 3, $STATWIDS->{st_int} = new CFClient::UI::Label valign => 0, align => +1, template => "30");	444	[0, 2, st_con => "Con", 30, "Constitution, physical health and toughness. Determines how many healthpoints you can have"],
396	$tbl->add (0, 4, $STATWIDS->{st_wis} = new CFClient::UI::Label valign => 0, align => +1, template => "30");	445	[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"],
397	$tbl->add (0, 5, $STATWIDS->{st_pow} = new CFClient::UI::Label valign => 0, align => +1, template => "30");	446	[0, 4, st_wis => "Wis", 30, "Wisdom, the ability to learn and use divine magic (prayers). Determines how many grace points you can have"],
398	$tbl->add (0, 6, $STATWIDS->{st_cha} = new CFClient::UI::Label valign => 0, align => +1, template => "30");	447	[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, 6, st_cha => "Cha", 30, "Charisma, how well you are received by NPCs. Affects buying and selling prices in shops."],
399		449
400	$tbl->add (1, 0, $STATWIDS->{st_str_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Str");	450	[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."],
401	$tbl->add (1, 1, $STATWIDS->{st_dex_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Dex");	451	[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."],
402	$tbl->add (1, 2, $STATWIDS->{st_con_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Con");	452	[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."],
403	$tbl->add (1, 3, $STATWIDS->{st_int_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Int");	453	[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."],
404	$tbl->add (1, 4, $STATWIDS->{st_wis_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Wis");	454	[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."],
405	$tbl->add (1, 5, $STATWIDS->{st_pow_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Pow");	455	[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."],
406	$tbl->add (1, 6, $STATWIDS->{st_cha_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Cha");	456	) {
		457	my ($col, $row, $id, $label, $template, $tooltip) = @$_;
407		458
408	$tbl->add (2, 0, $STATWIDS->{st_wc} = new CFClient::UI::Label valign => 0, align => +1, template => "-120");	459	$tbl->add ($col , $row, $STATWIDS->{$id} = new CFClient::UI::Label
409	$tbl->add (2, 1, $STATWIDS->{st_ac} = new CFClient::UI::Label valign => 0, align => +1, template => "-120");	460	font => $FONT_FIXED, can_hover => 1, can_events => 1, valign => 0, align => +1, template => $template, tooltip => $tooltip);
410	$tbl->add (2, 2, $STATWIDS->{st_dam} = new CFClient::UI::Label valign => 0, align => +1, template => "120");	461	$tbl->add ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFClient::UI::Label
411	$tbl->add (2, 3, $STATWIDS->{st_arm} = new CFClient::UI::Label valign => 0, align => +1, template => "120");	462	font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $black, valign => 0, align => -1, text => $label, tooltip => $tooltip);
412	$tbl->add (2, 4, $STATWIDS->{st_spd} = new CFClient::UI::Label valign => 0, align => +1, template => "10.54");	463	}
413	$tbl->add (2, 5, $STATWIDS->{st_wspd} = new CFClient::UI::Label valign => 0, align => +1, template => "9");
414
415	$tbl->add (3, 0, $STATWIDS->{st_wc_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Wc");
416	$tbl->add (3, 1, $STATWIDS->{st_ac_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Ac");
417	$tbl->add (3, 2, $STATWIDS->{st_dam_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Dam");
418	$tbl->add (3, 3, $STATWIDS->{st_arm_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Arm");
419	$tbl->add (3, 4, $STATWIDS->{st_spd_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Sp");
420	$tbl->add (3, 5, $STATWIDS->{st_wspd_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "WSp");
421		464
422	$hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);	465	$hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);
423		466
424	my $row = 0;	467	my $row = 0;
425	my $col = 0;	468	my $col = 0;
426		469
427	my %resist_names = (	470	my %resist_names = (
428	slow => "Slow",	471	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.)",
429	holyw => "Holy Word",	472	holyw => "Holy Word (resistance you against getting the fear when someone whose god doesn't like you spells the holy word on you.)",
430	conf => "Confusion",	473	conf => "Confusion (If you are hit by confusion you will move into random directions, and likely into monsters.)",
431	fire => "Fire",	474	fire => "Fire (just your resistance to fire spells like burning hands, dragonbreath, meteor swarm fire, ...)",
432	depl => "Depletion",	475	depl => "Depletion (some monsters and other effects can cause stats depletion)",
433	magic => "Magic",	476	magic => "Magic (resistance to magic spells like magic missile or similar)",
434	drain => "Draining",	477	drain => "Draining (some monsters (e.g. vampires) and other effects can steal experience)",
435	acid => "Acid",	478	acid => "Acid (resistance to acid, acid hurts pretty much and also corrodes your weapons)",
436	pois => "Poison",	479	pois => "Poison (resistance to getting poisoned)",
437	para => "Paralysation",	480	para => "Paralysation (this resistance affects the chance you get paralysed)",
438	deat => "Death",	481	deat => "Death (resistance against death spells)",
439	phys => "Physical",	482	phys => "Physical (this is the resistance against physical attacks, like when a monster hit you in melee combat)",
440	blind => "Blind",	483	blind => "Blind (blind resistance affects the chance of a successful blinding attack)",
441	fear => "Fear",	484	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)",
442	tund => "Turn undead",	485	tund => "Turn undead",
443	elec => "Electricity",	486	elec => "Electricity (resistance againt electricity, spells like large lightning, small lightning, ...)",
444	cold => "Cold",	487	cold => "Cold (this is your resistance against cold spells like icestorm, snowstorm, ...)",
445	ghit => "Ghost hit",	488	ghit => "Ghost hit (special attack used by ghosts and ghost-like beings)",
446	);	489	);
447	for (qw/slow holyw conf fire depl magic	490	for (qw/slow holyw conf fire depl magic
448	drain acid pois para deat phys	491	drain acid pois para deat phys
449	blind fear tund elec cold ghit/)	492	blind fear tund elec cold ghit/)
450	{	493	{
451	$tbl2->add ($col, $row,	494	$tbl2->add ($col, $row,
452	$STATWIDS->{"res_$_"} =	495	$STATWIDS->{"res_$_"} =
453	new CFClient::UI::Label	496	new CFClient::UI::Label
		497	font => $FONT_FIXED,
454	template => "-100%",	498	template => "-100%",
455	align => +1,	499	align => +1,
456	valign => 0,	500	valign => 0,
		501	can_events => 1,
		502	can_hover => 1,
457	tooltip => $resist_names{$_}	503	tooltip => $resist_names{$_},
458	);	504	);
459	$tbl2->add ($col + 1, $row, new CFClient::UI::Image	505	$tbl2->add ($col + 1, $row, new CFClient::UI::Image
		506	font => $FONT_FIXED,
460	can_hover => 1,	507	can_hover => 1,
461	can_events => 1,	508	can_events => 1,
462	image => "ui/resist/resist_$_.png",	509	image => "ui/resist/resist_$_.png",
463	tooltip => $resist_names{$_}	510	tooltip => $resist_names{$_},
464	);	511	);
465		512
466	$row++;	513	$row++;
467	if ($row % 6 == 0) {	514	if ($row % 6 == 0) {
468	$col += 2;	515	$col += 2;
…		…
547		594
548	}	595	}
549		596
550	sub metaserver_dialog {	597	sub metaserver_dialog {
551	my $dialog = new CFClient::UI::FancyFrame	598	my $dialog = new CFClient::UI::FancyFrame
552	title => "Metaserver",	599	title => "Server List",
553	child => (my $vbox = new CFClient::UI::VBox);	600	child => (my $vbox = new CFClient::UI::VBox);
554		601
555	$vbox->add ($dialog->{table} = new CFClient::UI::Table);	602	$vbox->add ($dialog->{table} = new CFClient::UI::Table);
556		603
557	$dialog	604	$dialog
558	}	605	}
		606
		607	my $METASERVER_ATIME;
559		608
560	sub update_metaserver {	609	sub update_metaserver {
561	my ($HOST) = @_;	610	my ($HOST) = @_;
562		611
563	status "fetching metaserver list...";	612	return if $METASERVER_ATIME > time;
		613	$METASERVER_ATIME = time + 60;
		614
		615	my $table = $METASERVER->{table};
		616	$table->clear;
		617	$table->add (0, 0, my $label = new CFClient::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
564		618
565	my $buf;	619	my $buf;
566		620
567	my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;	621	my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;
		622
		623	unless ($fh) {
		624	$label->set_text ("unable to contact metaserver: $!");
		625	return;
		626	}
568		627
569	Event->io (fd => $fh, poll => 'r', cb => sub {	628	Event->io (fd => $fh, poll => 'r', cb => sub {
570	my $res = sysread $fh, $buf, 8192, length $buf;	629	my $res = sysread $fh, $buf, 8192, length $buf;
571		630
572	if (!defined $res) {	631	if (!defined $res) {
573	$_[0]->w->cancel;	632	$_[0]->w->cancel;
574	status "metaserver: $!";	633	$label->set_text ("error while retrieving server list: $!");
575	} elsif ($res == 0) {	634	} elsif ($res == 0) {
576	$_[0]->w->cancel;	635	$_[0]->w->cancel;
577	status "server list retrieved";	636	status "server list retrieved";
578		637
579	my $table = $METASERVER->{table};	638	utf8::decode $buf if utf8::valid $buf;
580		639
581	$table->clear;	640	$table->clear;
582		641
583	my @col = qw(Use #Users Host Uptime Version Description);	642	my @col = qw(Use #Users Host Uptime Version Description);
584	$table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])	643	$table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])
…		…
608	$m = [$users, $host, $uptime, $version, $desc];	667	$m = [$users, $host, $uptime, $version, $desc];
609		668
610	$y++;	669	$y++;
611		670
612	$table->add (0, $y, new CFClient::UI::VBox children => [	671	$table->add (0, $y, new CFClient::UI::VBox children => [
613	(new CFClient::UI::Button text => " ", connect_activate => sub {	672	(new CFClient::UI::Button text => "Use", connect_activate => sub {
614	$HOST->set_text ($CFG->{host} = $host);	673	$HOST->set_text ($CFG->{host} = $host);
615	}),	674	}),
616	(new CFClient::UI::Empty expand => 1),	675	(new CFClient::UI::Empty expand => 1),
617	]);	676	]);
618		677
619	$table->add ($_ + 1, $y, new CFClient::UI::Label align => $align[$_], text => $m->[$_], fontsize => 0.8)	678	$table->add ($_ + 1, $y, new CFClient::UI::Label
		679	ellipsise => 0, align => $align[$_], text => $m->[$_], fontsize => 0.8)
620	for 0 .. $#$m;	680	for 0 .. $#$m;
621	}	681	}
622	}	682	}
623	});	683	});
624	}	684	}
…		…
647		707
648	$METASERVER = metaserver_dialog;	708	$METASERVER = metaserver_dialog;
649		709
650	$vbox->add (new CFClient::UI::Flopper	710	$vbox->add (new CFClient::UI::Flopper
651	expand => 1,	711	expand => 1,
652	text => "Metaserver",	712	text => "Server List",
653	other => $METASERVER,	713	other => $METASERVER,
654	tooltip => "Show a list of avaible crossfire servers",	714	tooltip => "Show a list of available crossfire servers",
655	connect_open => sub {	715	connect_open => sub {
656	update_metaserver $HOST;	716	update_metaserver $HOST;
657	}	717	}
658	);	718	);
659	}	719	}
…		…
677	my ($self, $value) = @_;	737	my ($self, $value) = @_;
678	$CFG->{password} = $value;	738	$CFG->{password} = $value;
679	}	739	}
680	);	740	);
681		741
682	$table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "Def. say cmd");
683	$table->add (1, 6, my $saycmd = new CFClient::UI::Entry
684	text => $CFG->{say_command},
685	tooltip => "This is the command that will be used if you write a line in the message window entry. "
686	."Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
687	."But you could also set it to 'tell <playername>' to only chat with that user.",
688	connect_changed => sub {
689	my ($self, $value) = @_;
690	$CFG->{say_command} = $value;
691	}
692	);
693
694	$table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");	742	$table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
695	$table->add (1, 7, new CFClient::UI::Slider	743	$table->add (1, 7, new CFClient::UI::Slider
696	req_w => 100,	744	req_w => 100,
697	range => [$CFG->{mapsize}, 10, 100 + 1, 1],	745	range => [$CFG->{mapsize}, 10, 100 + 1, 1, 1],
698	tooltip => "This is the size of the portion of the map update the server sends you. "	746	tooltip => "This is the size of the portion of the map update the server sends you. "
699	."If you set this to a high value you will be able to see further for example.",	747	."If you set this to a high value you will be able to see further for example.",
700	connect_changed => sub {	748	connect_changed => sub {
701	my ($self, $value) = @_;	749	my ($self, $value) = @_;
702		750
703	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;	751	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;
704	},	752	},
705	);	753	);
706		754
707	$table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Login", connect_activate => sub {	755	$table->add (0, 8, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");
708	start_game;	756	$table->add (1, 8, new CFClient::UI::Entry
		757	text => $CFG->{output_count},
		758	tooltip => "Should be set to 1 unless you know what you are doing",
		759	connect_changed => sub { $CFG->{output_count} = $_[1] },
709	});	760	);
		761
		762	$table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");
		763	$table->add (1, 9, new CFClient::UI::Entry
		764	text => $CFG->{output_sync},
		765	tooltip => "Should be set to 1 unless you know what you are doing",
		766	connect_changed => sub { $CFG->{output_sync} = $_[1] },
		767	);
		768
		769	$table->add (1, 10, $LOGIN_BUTTON = new CFClient::UI::Button
		770	expand => 1,
		771	align => 0,
		772	text => "Login",
		773	connect_activate => sub {
		774	$CONN ? stop_game
		775	: start_game;
		776	},
		777	);
710		778
711	$dialog	779	$dialog
712	}	780	}
713		781
714	sub message_window {	782	sub message_window {
715	my $window = new CFClient::UI::FancyFrame	783	my $window = new CFClient::UI::FancyFrame
716	title => "Messages",	784	title => "Messages",
717	border_bg => [1, 1, 1, 0.5],	785	border_bg => [1, 1, 1, 1],
718	bg => [0.3, 0.3, 0.3, 0.8],	786	bg => [0, 0, 0, 0.5],
719	user_w => int $::WIDTH / 3,	787	user_w => int $::WIDTH / 3,
720	user_h => int $::HEIGHT / 5,	788	user_h => int $::HEIGHT / 5,
721	child => (my $vbox = new CFClient::UI::VBox);	789	child => (my $vbox = new CFClient::UI::VBox);
722		790
723	$vbox->add ($LOGVIEW = new CFClient::UI::TextView	791	$vbox->add ($LOGVIEW);
724	expand => 1,
725	font => $FONT_FIXED,
726	fontsize => $::CFG->{log_fontsize},
727	);
728		792
729	$vbox->add (my $input = new CFClient::UI::Entry	793	$vbox->add (my $input = new CFClient::UI::Entry
730	connect_focus_in => sub {	794	connect_focus_in => sub {
731	my ($input, $prev_focus) = @_;	795	my ($input, $prev_focus) = @_;
732		796
…		…
763	};	827	};
764		828
765	$window	829	$window
766	}	830	}
767		831
		832	sub make_inventory_window {
		833	my $invwin = new CFClient::UI::FancyFrame
		834	user_w => $WIDTH * (4/5), user_h => $HEIGHT * (4/5), title => "Inventory";
		835
		836	$invwin->add (my $hb = new CFClient::UI::HBox expand => 1);
		837
		838	$hb->add (my $vb1 = new CFClient::UI::VBox expand => 1);
		839	$vb1->add (my $lbl = new CFClient::UI::Label);
		840	$lbl->set_text ("Player");
		841	$vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
		842
		843	$hb->add (my $vb2 = new CFClient::UI::VBox expand => 1);
		844	$vb2->add ($INVR_LBL = new CFClient::UI::Label);
		845	$INVR_LBL->set_text ("Floor");
		846	$vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);
		847
		848	$invwin
		849	}
		850
768	sub sdl_init {	851	sub sdl_init {
769	CFClient::SDL_Init	852	CFClient::SDL_Init
770	and die "SDL::Init failed!\n";	853	and die "SDL::Init failed!\n";
771	}	854	}
772		855
773	sub video_init {	856	sub video_init {
774	sdl_init;	857	sdl_init;
775		858
		859	$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
		860
776	($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };	861	($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
777	$FULLSCREEN = $CFG->{fullscreen};	862	$FULLSCREEN = $CFG->{fullscreen};
778	$FAST = $CFG->{fast};	863	$FAST = $CFG->{fast};
779		864
780	CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN	865	CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
781	or die "SDL_SetVideoMode failed!\n";	866	or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";
782		867
783	$SDL_ACTIVE = 1;	868	$SDL_ACTIVE = 1;
784
785	$LAST_REFRESH = time - 0.01;	869	$LAST_REFRESH = time - 0.01;
786		870
787	CFClient::gl_init;	871	CFClient::gl_init;
788		872
789	$FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};	873	$FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
790		874
		875	$CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
		876
791	#############################################################################	877	#############################################################################
792		878
		879	unless ($DEBUG_STATUS) {
		880	# create the widgets
		881
793	$DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100;	882	$DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100, req_x => -1;
794	$DEBUG_STATUS->show;	883	$DEBUG_STATUS->show;
795		884
796	$STATUS_LINE = new CFClient::UI::Label	885	$STATUSBOX = new CFClient::UI::Statusbox;
797	padding => 0,	886	$STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", pri => -100, color => [1, 1, 1, 0.8]);
798	y => $HEIGHT - $FONTSIZE * 1.8;
799	$STATUS_LINE->show;
800		887
801	$ALT_ENTER_MESSAGE = new CFClient::UI::Label	888	(new CFClient::UI::Frame
802	padding => 0,	889	bg => [0, 0, 0, 0.4],
803	fontsize => 0.8,	890	req_y => -1,
804	markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode";	891	child => $STATUSBOX,
805	$ALT_ENTER_MESSAGE->show;	892	)->show;
806	$ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h});
807		893
808	$CFClient::UI::ROOT->add ($MAPWIDGET = new CFClient::MapWidget);	894	CFClient::UI::FancyFrame->new (
809	$MAPWIDGET->focus_in;	895	border_bg => [1, 1, 1, 192/255],
		896	bg => [1, 1, 1, 0],
		897	child => ($MAPMAP = new CFClient::MapWidget::MapMap),
		898	)->show;
		899
		900	$MAPWIDGET = new CFClient::MapWidget;
810	$MAPWIDGET->connect (activate_console => sub {	901	$MAPWIDGET->connect (activate_console => sub {
811	my ($mapwidget, $preset) = @_;	902	my ($mapwidget, $preset) = @_;
812		903
813	if ($CONSOLE) {	904	if ($CONSOLE) {
814	$CONSOLE->{input}->{auto_activated} = 1;	905	$CONSOLE->{input}->{auto_activated} = 1;
815	$CONSOLE->{input}->focus_in;	906	$CONSOLE->{input}->focus_in;
816		907
817	if ($preset && $CONSOLE->{input}->get_text eq '') {	908	if ($preset && $CONSOLE->{input}->get_text eq '') {
818	$CONSOLE->{input}->set_text ($preset);	909	$CONSOLE->{input}->set_text ($preset);
		910	}
819	}	911	}
820	}	912	});
821	});	913	$MAPWIDGET->show;
		914	$MAPWIDGET->focus_in;
822		915
823	$CFClient::UI::ROOT->add ($BUTTONBAR = new CFClient::UI::HBox);	916	$LOGVIEW = new CFClient::UI::TextView
		917	expand => 1,
		918	font => $FONT_FIXED,
		919	fontsize => $::CFG->{log_fontsize},
		920	;
824		921
		922	$BUTTONBAR = new CFClient::UI::HBox;
		923
825	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup);	924	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup);
826	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup);	925	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup);
827	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);	926	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);
828		927
829	$CFClient::UI::ROOT->add (make_gauge_window); # XXX: this has to be set before make_stats_window as make_stats_window calls update_stats_window which updated the gauges also X-D	928	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
		929
830	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window);	930	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window);
		931	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => make_inventory_window);
831		932
832	$BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {	933	$BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {
833	CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";	934	CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
834	status "Configuration Saved";	935	status "Configuration Saved";
835	});	936	});
836		937
		938	$BUTTONBAR->show;
		939
		940	$STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
		941
		942	# delay till geometry is constant
		943	$CFClient::UI::ROOT->on_post_alloc (startup => sub {
837	$BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup	944	$BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
		945	my $widget = $GAUGES->{win};
		946	$widget->move (0, $HEIGHT - $widget->{h});#d# to in toplevel
		947	});
		948	force_refresh ();
		949	}
838	}	950	}
839		951
840	sub video_shutdown {	952	sub video_shutdown {
841	$CFClient::UI::ROOT->{children} = [];
842	undef $SDL_ACTIVE;	953	undef $SDL_ACTIVE;
843	}	954	}
844		955
845	my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#	956	my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
846	my $bgmusic;#TODO#hack#d#	957	my $bgmusic;#TODO#hack#d#
		958
		959	sub audio_channel_finished {
		960	my ($channel) = @_;
		961
		962	#warn "channel $channel finished\n";#d#
		963	}
847		964
848	sub audio_music_finished {	965	sub audio_music_finished {
849	return unless $CFG->{bgm_enable};	966	return unless $CFG->{bgm_enable};
850		967
851	# TODO: hack, do play loop and mood music	968	# TODO: hack, do play loop and mood music
…		…
855	push @bgmusic, shift @bgmusic;	972	push @bgmusic, shift @bgmusic;
856	}	973	}
857		974
858	sub audio_init {	975	sub audio_init {
859	if ($CFG->{audio_enable}) {	976	if ($CFG->{audio_enable}) {
860	if (open my $fh, "<:utf8", CFClient::find_rcfile "sounds/config") {	977	if (open my $fh, "<", CFClient::find_rcfile "sounds/config") {
861	$SDL_MIXER = !CFClient::Mix_OpenAudio;	978	$SDL_MIXER = !CFClient::Mix_OpenAudio;
862	CFClient::Mix_AllocateChannels 8;	979	CFClient::Mix_AllocateChannels 8;
863	CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;	980	CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
864		981
865	audio_music_finished;	982	audio_music_finished;
…		…
892	}	1009	}
893		1010
894	my %animate_object;	1011	my %animate_object;
895	my $animate_timer;	1012	my $animate_timer;
896		1013
897	my $want_refresh;
898	my $can_refresh;
899
900	my $fps = 9;	1014	my $fps = 9;
901		1015
		1016	my %demo;#d#
		1017
902	sub force_refresh {	1018	sub force_refresh {
903	$fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05;	1019	$fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
904	debug sprintf "%3.2f", $fps;	1020	debug sprintf "%3.2f", $fps;
905		1021
906	$want_refresh = 0;
907	$can_refresh = 0;
908
909	$CFClient::UI::ROOT->draw;	1022	$CFClient::UI::ROOT->draw;
910		1023
		1024	$WANT_REFRESH = 0;
		1025	$CAN_REFRESH = 0;
		1026	$LAST_REFRESH = $NOW;
		1027
		1028	0 && do {
		1029	# some weird model-drawing code, just a joke right now
		1030	use CFClient::OpenGL;
		1031
		1032	$demo{t}{eye_auv} ||= new_from_file CFClient::Texture "eye2.png" or die;
		1033	$demo{t}{body_auv} ||= new_from_file CFClient::Texture "body_auv3.png" or die;
		1034	$demo{r} ||= do {
		1035	my $mod = Compress::LZF::sthaw do { local $/; open my $fh, "<:raw:perlio", "dread.lz3"; <$fh> };
		1036	$mod->{v} = pack "f*", @{$mod->{v}};
		1037	$_ = [scalar @$_, pack "S!*", @$_]
		1038	for values %{$mod->{g}};
		1039	$mod
		1040	};
		1041
		1042	my $r = $demo{r} or die;
		1043
		1044	glDepthMask 1;
		1045	glClear GL_DEPTH_BUFFER_BIT;
		1046	glEnable GL_TEXTURE_2D;
		1047	glEnable GL_DEPTH_TEST;
		1048	glEnable GL_CULL_FACE;
		1049	glShadeModel $::FAST ? GL_FLAT : GL_SMOOTH;
		1050
		1051	glMatrixMode GL_PROJECTION;
		1052	glLoadIdentity;
		1053	glFrustum -1 * ($::WIDTH / $::HEIGHT), 1 * ($::WIDTH / $::HEIGHT), 1, -1, 1, 10000;
		1054	#glOrtho 0, $::WIDTH, 0, $::HEIGHT, -10000, 10000;
		1055	glMatrixMode GL_MODELVIEW;
		1056	glLoadIdentity;
		1057
		1058	glPushMatrix;
		1059	glTranslate 0, 0, -800;
		1060	glScale 1, -1, 1;
		1061	glRotate $NOW * 1000 % 36000 / 5, 0, 1, 0;
		1062	glRotate $NOW * 1000 % 36000 / 6, 1, 0, 0;
		1063	glRotate $NOW * 1000 % 36000 / 7, 0, 0, 1;
		1064	glScale 50, 50, 50;
		1065
		1066	glInterleavedArrays GL_T2F_N3F_V3F, 0, $r->{v};
		1067	while (my ($k, $v) = each %{$r->{g}}) {
		1068	glBindTexture GL_TEXTURE_2D, ($demo{t}{$k}{name} or die);
		1069	glDrawElements GL_TRIANGLES, $v->[0], GL_UNSIGNED_SHORT, $v->[1];
		1070	}
		1071
		1072	glPopMatrix;
		1073
		1074	glShadeModel GL_FLAT;
		1075	glDisable GL_DEPTH_TEST;
		1076	glDisable GL_TEXTURE_2D;
		1077	glDepthMask 0;
		1078
		1079	$WANT_REFRESH++;
		1080	};
		1081
911	CFClient::SDL_GL_SwapBuffers;	1082	CFClient::SDL_GL_SwapBuffers;
912
913	$LAST_REFRESH = $NOW;
914	}	1083	}
915		1084
916	my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {	1085	my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {
917	$NOW = time;	1086	$NOW = time;
918		1087
919	($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)	1088	($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
920	for CFClient::SDL_PollEvent;	1089	for CFClient::SDL_PollEvent;
921		1090
922	if (%animate_object) {	1091	if (%animate_object) {
923	$_->animate ($LAST_REFRESH - $NOW) for values %animate_object;	1092	$_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
924	$want_refresh++;	1093	$WANT_REFRESH++;
925	}	1094	}
926		1095
927	if ($want_refresh) {	1096	if ($WANT_REFRESH) {
928	force_refresh;	1097	force_refresh;
929	} else {	1098	} else {
930	$can_refresh = 1;	1099	$CAN_REFRESH = 1;
931	}	1100	}
932	});	1101	});
933
934	sub refresh {
935	$want_refresh++;
936	}
937		1102
938	sub animation_start {	1103	sub animation_start {
939	my ($widget) = @_;	1104	my ($widget) = @_;
940	$animate_object{$widget} = $widget;	1105	$animate_object{$widget} = $widget;
941	}	1106	}
…		…
945	delete $animate_object{$widget};	1110	delete $animate_object{$widget};
946	}	1111	}
947		1112
948	@conn::ISA = Crossfire::Protocol::;	1113	@conn::ISA = Crossfire::Protocol::;
949		1114
		1115	sub conn::new {
		1116	my $class = shift;
		1117
		1118	my $self = $class->Crossfire::Protocol::new (@_);
		1119
		1120	$MAPWIDGET->clr_commands;
		1121
		1122	my $parser = new Pod::POM;
		1123	my $pod = $parser->parse_file (CFClient::find_rcfile "pod/command_help.pod");
		1124
		1125	for my $head2 ($pod->head2) {
		1126	$head2->title =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x
		1127	or next;
		1128
		1129	my $cmd = $1;
		1130	my @args = split /\|/, $2;
		1131	@args = (".*") unless @args;
		1132
		1133	my $text = CFClient::pod_to_pango $head2->content;
		1134
		1135	for my $arg (@args) {
		1136	$arg = $arg eq ".*" ? "" : " $arg";
		1137
		1138	$MAPWIDGET->add_command ("$cmd$arg", $text);
		1139	}
		1140	}
		1141
		1142	$self
		1143	}
		1144
950	sub conn::stats_update {	1145	sub conn::stats_update {
951	my ($self, $stats) = @_;	1146	my ($self, $stats) = @_;
		1147
		1148	if (my $exp = $stats->{Crossfire::Protocol::CS_STAT_EXP64}) {
		1149	my $diff = $exp - $self->{prev_exp};
		1150	$STATUSBOX->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5)
		1151	if exists $self->{prev_exp} && $diff;
		1152	$self->{prev_exp} = $exp;
		1153	}
952		1154
953	update_stats_window ($stats);	1155	update_stats_window ($stats);
954	}	1156	}
955		1157
956	sub conn::user_send {	1158	sub conn::user_send {
…		…
1011	$self->set_texture ($id => $data);	1213	$self->set_texture ($id => $data);
1012	}	1214	}
1013	}	1215	}
1014	}	1216	}
1015		1217
		1218	# hardcode /world/world_xxx_xxx map names, the savings are enourmous,
		1219	# (server resource,s latency, bandwidth), so this hack is warranted.
		1220	# the right fix is to make real tiled maps with an overview file
		1221	sub conn::send_mapinfo {
		1222	my ($self, $data, $cb) = @_;
		1223
		1224	if ($self->{map_info}[0] =~ m%^/world/world_(\d\d\d)_(\d\d\d)$%) {
		1225	my ($wx, $wy) = ($1, $2);
		1226
		1227	if ($data =~ /^spatial ([1-4]+)$/) {
		1228	my @dx = (0, 0, 1, 0, -1);
		1229	my @dy = (0, -1, 0, 1, 0);
		1230	my ($dx, $dy);
		1231
		1232	for (split //, $1) {
		1233	$dx += $dx[$_];
		1234	$dy += $dy[$_];
		1235	}
		1236
		1237	$cb->(spatial => 15,
		1238	$self->{map_info}[1] - $MAP->ox + $dx * 50,
		1239	$self->{map_info}[2] - $MAP->oy + $dy * 50,
		1240	50, 50,
		1241	sprintf "/world/world_%03d_%03d", $wx + $dx, $wy + $dy
		1242	);
		1243
		1244	return;
		1245	}
		1246	}
		1247
		1248	$self->SUPER::send_mapinfo ($data, $cb);
		1249	}
		1250
1016	# this method does a "flood fill" into every tile direction	1251	# this method does a "flood fill" into every tile direction
1017	# it assumes that tiles are arranged in a rectangular grid,	1252	# it assumes that tiles are arranged in a rectangular grid,
1018	# i.e. a map is the same as the left of the right map etc.	1253	# i.e. a map is the same as the left of the right map etc.
1019	# failure to comply are harmless and result in display errors	1254	# failure to comply are harmless and result in display errors
1020	# at worst.	1255	# at worst.
1021	sub conn::flood_fill {	1256	sub conn::flood_fill {
1022	my ($self, $gx, $gy, $path, $hash, $flags) = @_;	1257	my ($self, $block, $gx, $gy, $path, $hash, $flags) = @_;
1023		1258
1024	# the server does not allow map paths > 6	1259	# the server does not allow map paths > 6
1025	return if 6 <= length $path;	1260	return if 7 <= length $path;
1026		1261
1027	my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};	1262	my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
1028		1263
1029	for (	1264	for (
1030	[1, 0, -1],	1265	[1, 3, 0, -1],
1031	[2, 1, 0],	1266	[2, 4, 1, 0],
1032	[3, 0, 1],	1267	[3, 1, 0, 1],
1033	[4, -1, 0],	1268	[4, 2, -1, 0],
1034	) {	1269	) {
1035	my ($tile, $dx, $dy) = @$_;	1270	my ($tile, $tile2, $dx, $dy) = @$_;
		1271
		1272	next if $block & (1 << $tile);
		1273	my $block = $block | (1 << $tile2);
1036		1274
1037	my $gx = $gx + $dx;	1275	my $gx = $gx + $dx;
1038	my $gy = $gy + $dy;	1276	my $gy = $gy + $dy;
1039		1277
1040	next unless $flags & (1 << ($tile - 1));	1278	next unless $flags & (1 << ($tile - 1));
…		…
1042		1280
1043	my $neigh = $self->{neigh_map}{$hash} ||= [];	1281	my $neigh = $self->{neigh_map}{$hash} ||= [];
1044	if (my $info = $neigh->[$tile]) {	1282	if (my $info = $neigh->[$tile]) {
1045	my ($flags, $x, $y, $w, $h, $hash) = @$info;	1283	my ($flags, $x, $y, $w, $h, $hash) = @$info;
1046		1284
1047	$self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags)	1285	$self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
1048	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;	1286	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1049		1287
1050	} else {	1288	} else {
1051	$self->send_mapinfo ("spatial $path$tile", sub {	1289	$self->send_mapinfo ("spatial $path$tile", sub {
1052	my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;	1290	my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
1053		1291
1054	return if $mode ne "spatial";	1292	return if $mode ne "spatial";
1055		1293
1056	$x += $MAP->ox;	1294	$x += $MAP->ox;
1057	$y += $MAP->oy;	1295	$y += $MAP->oy;
1058		1296
1059	$self->load_map ($hash, $x, $y)	1297	$self->load_map ($hash, $x, $y)
1060	unless $self->{neigh_map}{$hash}[5]++;#d#	1298	unless $self->{neigh_map}{$hash}[5]++;#d#
1061		1299
1062	$neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];	1300	$neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
1063		1301
1064	$self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags)	1302	$self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
1065	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;	1303	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1066	});	1304	});
1067	}	1305	}
1068	}	1306	}
1069	}	1307	}
…		…
1073		1311
1074	$self->flush_map;	1312	$self->flush_map;
1075		1313
1076	my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);	1314	my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
1077		1315
1078	my $mapmapw = 250;	1316	my $mapmapw = $MAPMAP->{w};
1079	my $mapmaph = 250;	1317	my $mapmaph = $MAPMAP->{h};
1080		1318
1081	$self->{neigh_rect} = [	1319	$self->{neigh_rect} = [
1082	$ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,	1320	$ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
1083	$ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,	1321	$ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
1084	];	1322	];
1085		1323
1086	delete $self->{neigh_grid};	1324	delete $self->{neigh_grid};
1087	$self->flood_fill (0, 0, "", $hash, $flags);
1088		1325
1089	$x += $ox;	1326	$x += $ox;
1090	$y += $oy;	1327	$y += $oy;
1091		1328
1092	$self->{map_info} = [$hash, $x, $y, $w, $h];	1329	$self->{map_info} = [$hash, $x, $y, $w, $h];
1093		1330
1094	my $map = $self->{map_info}[0];
1095	$map =~ s/^.*?\/([^\/]+)$/\1/;	1331	(my $map = $hash) =~ s/^.*?\/([^\/]+)$/\1/;
1096	$STATWIDS->{map}->set_text ("Map: " . $map);	1332	$STATWIDS->{map}->set_text ("Map: " . $map);
1097		1333
1098	$self->load_map ($hash, $x, $y);	1334	$self->load_map ($hash, $x, $y);
		1335	$self->flood_fill (0, 0, 0, "", $hash, $flags);
1099	}	1336	}
1100		1337
1101	sub conn::face_find {	1338	sub conn::face_find {
1102	my ($self, $facenum, $face) = @_;	1339	my ($self, $facenum, $face) = @_;
1103		1340
…		…
1253	[0.55, 0.41, 0.13],	1490	[0.55, 0.41, 0.13],
1254	[0.99, 0.77, 0.26],	1491	[0.99, 0.77, 0.26],
1255	[0.74, 0.65, 0.41],	1492	[0.74, 0.65, 0.41],
1256	);	1493	);
1257		1494
		1495	my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
		1496
		1497	$text = CFClient::UI::Label::escape $text;
		1498	$text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g;
		1499	$text =~ s/\[color=(.*?)\](.*?)\[\/color\]/<span foreground='\1'>\2<\/span>/g;
		1500
1258	$LOGVIEW->add_paragraph ($color[$color], $text);	1501	$LOGVIEW->add_paragraph ($color[$color],
		1502	join "\n", map "$time $_", split /\n/, $text);
		1503
		1504	$STATUSBOX->add ($text,
		1505	group => $text,
		1506	fg => $color[$color],
		1507	timeout => 60,
		1508	tooltip_font => $::FONT_FIXED,
		1509	);
		1510	}
		1511
		1512	sub conn::drawextinfo {
		1513	my ($self, $color, $type, $subtype, $message) = @_;
		1514
		1515	$self->drawinfo ($color, $message);
1259	}	1516	}
1260		1517
1261	sub conn::spell_add {	1518	sub conn::spell_add {
1262	my ($self, $spell) = @_;	1519	my ($self, $spell) = @_;
1263		1520
1264	# TODO	1521	# TODO
1265	# create a widget dynamically, using spell face (CF::Protocol downloads them)	1522	# create a widget dynamically, using spell face (CF::Protocol downloads them)
1266	$MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message});	1523	$MAPWIDGET->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1267	$MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message});	1524	$MAPWIDGET->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1268	}	1525	}
1269		1526
1270	sub conn::spell_delete {	1527	sub conn::spell_delete {
1271	my ($self, $spell) = @_;	1528	my ($self, $spell) = @_;
1272	}	1529	}
1273		1530
1274	sub conn::addme_success {	1531	sub conn::addme_success {
1275	my ($self) = @_;	1532	my ($self) = @_;
1276		1533
		1534	$self->send ("command output-sync $CFG->{output_sync}");
		1535	$self->send ("command output-count $CFG->{output_count}");
		1536
1277	for my $skill (values %{$self->{skill_info}}) {	1537	for my $skill (values %{$self->{skill_info}}) {
1278	$MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'");	1538	$MAPWIDGET->add_command ("ready_skill $skill", CFClient::UI::Label::escape "Ready the skill '$skill'");
1279	$MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'");	1539	$MAPWIDGET->add_command ("use_skill $skill", CFClient::UI::Label::escape "Immediately use the skill '$skill'");
1280	}	1540	}
		1541	}
		1542
		1543	sub conn::eof {
		1544	$MAPWIDGET->clr_commands;
		1545
		1546	stop_game;
1281	}	1547	}
1282		1548
1283	sub update_floorbox {	1549	sub update_floorbox {
1284	$CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {	1550	$CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
		1551	return unless $CONN;
		1552
1285	$FLOORBOX->clear;	1553	$FLOORBOX->clear;
1286	$FLOORBOX->add (new CFClient::UI::Empty expand => 1);	1554	$FLOORBOX->add (new CFClient::UI::Empty expand => 1);
1287		1555
1288	my @items = values %{ $CONN->{container}{0} };	1556	my $count = 4;
1289		1557	for (@{ $CONN->{container}{0} }) {
1290	# we basically have to use the same sorting as everybody else	1558	if (--$count) {
1291	@items = sort { $a->{type} <=> $b->{type} } @items;	1559	$FLOORBOX->add (new CFClient::UI::InventoryItem item => $_);
1292		1560	} else {
1293	for my $item (reverse @items) {	1561	$FLOORBOX->add (new CFClient::UI::Label text => "More...");
1294	my $desc = $item->{nrof} < 2
1295	? $item->{name}
1296	: "$item->{nrof} $item->{name_pl}";
1297	# todo: animation widget, face widget, weight(?) etc.
1298	$FLOORBOX->add (my $hbox = new CFClient::UI::HBox
1299	tooltip => (CFClient::UI::Label->escape ($desc)
1300	. "\n<small>leftclick - pick up\nmiddle click - apply\nrightclick - menu</small>"),
1301	can_hover => 1,
1302	can_events => 1,
1303	connect_button_down => sub {
1304	my ($self, $ev, $x, $y) = @_;
1305
1306	# todo: maybe put examine on 1? but should just be a tooltip :(
1307	if ($ev->{button} == 1) {
1308	$CONN->send ("move $CONN->{player}{tag} $item->{tag} 0");
1309	} elsif ($ev->{button} == 2) {
1310	$CONN->send ("apply $item->{tag}");
1311	} elsif ($ev->{button} == 3) {
1312	# examine, lock, mark, maybe other things
1313	warn "MENU not implemented yet\n";
1314	}
1315
1316	1
1317	},	1562	last;
1318	);
1319
1320	$hbox->add (new CFClient::UI::Face
1321	can_events => 0,
1322	face => $item->{face},
1323	anim => $item->{anim},
1324	animspeed => $item->{animspeed},
1325	);
1326		1563	}
1327	$hbox->add (new CFClient::UI::Label
1328	can_events => 0,
1329	text => $desc,
1330	);
1331	}	1564	}
1332	});	1565	});
1333	refresh;	1566
		1567	$WANT_REFRESH++;
1334	}	1568	}
1335		1569
1336	sub conn::container_add {	1570	sub conn::container_add {
1337	my ($self, $id, $items) = @_;	1571	my ($self, $tag, $items) = @_;
1338		1572
1339	update_floorbox if $id == 0;	1573	#d# print "container_add: container $tag ($self->{player}{tag})\n";
		1574
		1575	if ($tag == 0) {
		1576	update_floorbox;
		1577	$OPENCONT = 0;
		1578	$INVR_LBL->set_text ("Floor");
		1579	$INVR->set_items ($self->{container}{0});
		1580	} elsif ($tag == $self->{player}{tag}) {
		1581	$INVR_LBL->set_text ("Player");
		1582	$INV->set_items ($self->{container}{$self->{player}{tag}})
		1583	} else {
		1584	$OPENCONT = $tag;
		1585	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
		1586	$INVR->set_items ($self->{container}{$tag});
		1587	}
		1588
1340	# $self-<{player}{tag} => player inv	1589	# $self-<{player}{tag} => player inv
1341	#use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};	1590	#use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1342	}	1591	}
1343		1592
1344	sub conn::container_clear {	1593	sub conn::container_clear {
1345	my ($self, $id) = @_;	1594	my ($self, $tag) = @_;
1346		1595
1347	update_floorbox if $id == 0;	1596	#d# print "container_clear: container $tag ($self->{player}{tag})\n";
		1597
		1598	if ($tag == 0) {
		1599	update_floorbox;
		1600	$OPENCONT = 0;
		1601	$INVR_LBL->set_text ("Floor");
		1602	$INVR->set_items ($self->{container}{0});
		1603	} elsif ($tag == $self->{player}{tag}) {
		1604	$INVR_LBL->set_text ("Player");
		1605	$INV->set_items ($self->{container}{$tag})
		1606	} else {
		1607	$OPENCONT = $tag;
		1608	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
		1609	$INVR->set_items ($self->{container}{$tag});
		1610	}
		1611
1348	# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};	1612	# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1349	}	1613	}
1350		1614
1351	sub conn::item_delete {	1615	sub conn::item_delete {
1352	my ($self, @items) = @_;	1616	my ($self, @items) = @_;
1353		1617
1354	for (@items) {	1618	for (@items) {
1355	update_floorbox if $_->{container} == 0;	1619	#d# print "item_delete: $_->{tag} from $_->{container} ($self->{player}{tag})\n";
		1620
		1621	if ($_->{container} == 0) {
		1622	update_floorbox;
		1623	$OPENCONT = 0;
		1624	$INVR_LBL->set_text ("Floor");
		1625	$INVR->set_items ($self->{container}{0});
		1626	} elsif ($_->{container} == $self->{player}{tag}) {
		1627	$INVR_LBL->set_text ("Player");
		1628	$INV->set_items ($self->{container}{$self->{player}{tag}})
		1629	} else {
		1630	$OPENCONT = $_->{container};
		1631	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
		1632	$INVR->set_items ($self->{container}{$_->{container}});
		1633	}
1356	}	1634	}
1357	}	1635	}
1358		1636
1359	sub conn::item_update {	1637	sub conn::item_update {
1360	my ($self, $item) = @_;	1638	my ($self, $item) = @_;
1361		1639
1362	update_floorbox if $item->{container} == 0;	1640	#d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($OPENCONT)\n";
		1641
		1642	if ($item->{tag} == $OPENCONT && not ($item->{flags} & Crossfire::Protocol::F_OPEN)) {
		1643	$OPENCONT = 0;
		1644	$INVR_LBL->set_text ("Floor");
		1645	$INVR->set_items ($self->{container}{0});
		1646
		1647	$item->{widget}->update_item
		1648	if $item->{widget};
		1649	} else {
		1650	if ($item->{container} == 0) {
		1651	update_floorbox;
		1652	$OPENCONT = 0;
		1653	$INVR_LBL->set_text ("Floor");
		1654	$INVR->set_items ($self->{container}{0});
		1655	} elsif ($item->{container} == $self->{player}{tag}) {
		1656	$INV->set_items ($self->{container}{$item->{container}})
		1657	}
		1658	}
1363	}	1659	}
1364		1660
1365	%SDL_CB = (	1661	%SDL_CB = (
1366	CFClient::SDL_QUIT => sub {	1662	CFClient::SDL_QUIT => sub {
1367	Event::unloop -1;	1663	Event::unloop -1;
1368	},	1664	},
1369	CFClient::SDL_VIDEORESIZE => sub {	1665	CFClient::SDL_VIDEORESIZE => sub {
1370	},	1666	},
1371	CFClient::SDL_VIDEOEXPOSE => \&refresh,	1667	CFClient::SDL_VIDEOEXPOSE => sub {
		1668	$WANT_REFRESH++;
		1669	},
1372	CFClient::SDL_ACTIVEEVENT => sub {	1670	CFClient::SDL_ACTIVEEVENT => sub {
1373	# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#	1671	# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
1374	},	1672	},
1375	CFClient::SDL_KEYDOWN => sub {	1673	CFClient::SDL_KEYDOWN => sub {
1376	if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {	1674	if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
…		…
1380	video_init;	1678	video_init;
1381	} else {	1679	} else {
1382	CFClient::UI::feed_sdl_key_down_event ($_[0]);	1680	CFClient::UI::feed_sdl_key_down_event ($_[0]);
1383	}	1681	}
1384	},	1682	},
1385	CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,	1683	CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
1386	CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,	1684	CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
1387	CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,	1685	CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
1388	CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,	1686	CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
1389	CFClient::SDL_USEREVENT => \&audio_music_finished,	1687	CFClient::SDL_USEREVENT => sub {
		1688	if ($_[0]{code} == 1) {
		1689	audio_channel_finished $_[0]{data1};
		1690	} elsif ($_[0]{code} == 0) {
		1691	audio_music_finished;
		1692	}
		1693	},
1390	);	1694	);
1391		1695
1392	#############################################################################	1696	#############################################################################
1393		1697
1394	$SIG{INT} = $SIG{TERM} = sub { exit };	1698	$SIG{INT} = $SIG{TERM} = sub { exit };
1395		1699
1396	$TILECACHE = CFClient::db_table "tilecache";
1397	$FACEMAP = CFClient::db_table "facemap";
1398
1399	CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
1400
1401	my %DEF_CFG = (
1402	sdl_mode => 0,
1403	width => 640,
1404	height => 480,
1405	fullscreen => 0,
1406	fast => 0,
1407	map_scale => 0.5,
1408	fow_enable => 1,
1409	fow_intensity => 0.45,
1410	fow_smooth => 0,
1411	gui_fontsize => 1,
1412	log_fontsize => 1,
1413	gauge_fontsize => 1,
1414	gauge_size => 0.35,
1415	stat_fontsize => 1,
1416	mapsize => 100,
1417	host => "crossfire.schmorp.de",
1418	say_command => 'say',
1419	audio_enable => 1,
1420	bgm_enable => 1,
1421	bgm_volume => 0.25,
1422	);
1423
1424	while (my ($k, $v) = each %DEF_CFG) {
1425	$CFG->{$k} = $v unless exists $CFG->{$k};
1426	}
1427
1428	sdl_init;
1429
1430	@SDL_MODES = reverse
1431	grep $_->[0] >= 640 && $_->[1] >= 480,
1432	CFClient::SDL_ListModes;
1433
1434	@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
1435
1436	$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
1437
1438	{	1700	{
		1701	local $SIG{__DIE__} = sub { CFClient::fatal $_[0] };
		1702
		1703	CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
		1704
		1705	$TILECACHE = CFClient::db_table "tilecache";
		1706	$FACEMAP = CFClient::db_table "facemap";
		1707
		1708	my %DEF_CFG = (
		1709	sdl_mode => 0,
		1710	width => 640,
		1711	height => 480,
		1712	fullscreen => 0,
		1713	fast => 0,
		1714	map_scale => 1,
		1715	fow_enable => 1,
		1716	fow_intensity => 0.45,
		1717	fow_smooth => 0,
		1718	gui_fontsize => 1,
		1719	log_fontsize => 1,
		1720	gauge_fontsize=> 1,
		1721	gauge_size => 0.35,
		1722	stat_fontsize => 1,
		1723	mapsize => 100,
		1724	host => "crossfire.schmorp.de",
		1725	say_command => 'say',
		1726	audio_enable => 1,
		1727	bgm_enable => 1,
		1728	bgm_volume => 0.25,
		1729	output_sync => 1,
		1730	output_count => 1,
		1731	);
		1732
		1733	while (my ($k, $v) = each %DEF_CFG) {
		1734	$CFG->{$k} = $v unless exists $CFG->{$k};
		1735	}
		1736
		1737	sdl_init;
		1738
		1739	@SDL_MODES = reverse
		1740	grep $_->[0] >= 640 && $_->[1] >= 480,
		1741	CFClient::SDL_ListModes;
		1742
		1743	@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
		1744
		1745	$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
		1746
		1747	{
1439	my @fonts = map CFClient::find_rcfile "fonts/$_", qw(	1748	my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
1440	DejaVuSans.ttf	1749	DejaVuSans.ttf
1441	DejaVuSansMono.ttf	1750	DejaVuSansMono.ttf
1442	DejaVuSans-Bold.ttf	1751	DejaVuSans-Bold.ttf
1443	DejaVuSansMono-Bold.ttf	1752	DejaVuSansMono-Bold.ttf
1444	DejaVuSans-Oblique.ttf	1753	DejaVuSans-Oblique.ttf
1445	DejaVuSansMono-Oblique.ttf	1754	DejaVuSansMono-Oblique.ttf
1446	DejaVuSans-BoldOblique.ttf	1755	DejaVuSans-BoldOblique.ttf
1447	DejaVuSansMono-BoldOblique.ttf	1756	DejaVuSansMono-BoldOblique.ttf
1448	);	1757	);
1449		1758
1450	CFClient::add_font $_ for @fonts;	1759	CFClient::add_font $_ for @fonts;
1451		1760
		1761	CFClient::pango_init;
		1762
1452	$FONT_PROP = new_from_file CFClient::Font $fonts[0];	1763	$FONT_PROP = new_from_file CFClient::Font $fonts[0];
1453	$FONT_FIXED = new_from_file CFClient::Font $fonts[1];	1764	$FONT_FIXED = new_from_file CFClient::Font $fonts[1];
1454		1765
1455	$FONT_PROP->make_default;	1766	$FONT_PROP->make_default;
1456	}	1767	}
1457		1768
		1769	# compare mono (ft) vs. rgba (cairo)
		1770	# ft - 1.8s, cairo 3s, even in alpha-only mode
		1771	# for my $rgba (0..1) {
		1772	# my $t1 = Time::HiRes::time;
		1773	# for (1..1000) {
		1774	# my $layout = CFClient::Layout->new ($rgba);
		1775	# $layout->set_text ("hallo" x 100);
		1776	# $layout->render;
		1777	# }
		1778	# my $t2 = Time::HiRes::time;
		1779	# warn $t2-$t1;
		1780	# }
		1781
1458	video_init;	1782	video_init;
1459	audio_init;	1783	audio_init;
		1784	}
1460		1785
1461	Event::loop;	1786	Event::loop;
1462		1787
1463	END { CFClient::SDL_Quit }	1788	END { CFClient::SDL_Quit }
1464		1789
		1790	=head1 pclient - Crossfire+ and Crossfire game client
1465		1791
		1792	Pclient is a Crossfire+ and Crossfire game client.
		1793
		1794	=head2 Features
		1795
		1796	=over 4
		1797
		1798	=item Fullscreen Map
		1799
		1800	PClient can uses a fullscreen map, which greatly enhances how much of the
		1801	game world you can see.
		1802
		1803	=item Persistent Map Cache (Crossfire+ only)
		1804
		1805	PClient can persistently cache all map data it received from the
		1806	server. This not only allows it to display an overview map, but also
		1807	ensures that once-explored areas will be available the next time you want
		1808	to explore more.
		1809
		1810	=item Hardware acceleration
		1811
		1812	Unlike most Crossfire clients, PClient take advantage of OpenGL hardware
		1813	acceleration. Most modern graphics cards have difficulties with 2D
		1814	acceleration, while 3D graphics is accelerated well.
		1815
		1816	=item No arbitrary limits
		1817
		1818	Unlike other Crossfire clients, pclient does not suffer from arbitrary
		1819	limits (like a fixed amount of face numbers). There are still limits, but
		1820	they are not arbitrarily low :)
		1821
		1822	=back
		1823
		1824	=head1 USAGE
		1825
		1826	=head2 The Map
		1827
		1828	The map is always displayed in the background, behind all other windows and UI elements.
		1829
		1830	#TODO# middle-click scrolls
		1831	#
		1832	# keys:
		1833	#
		1834	# a apply
		1835	# keypad moves, kp_5 applies ranged attack to self
		1836
		1837	Starting to type enters the I<completion mode>. In that mode, you can type
		1838	abbreviations or commands and have them executed as soon as they match a
		1839	valid command. This is best explained by a few examples:
		1840
		1841	Typing B<climb> will display a list of commands with I<climb> in their
		1842	name, such as I<ready_skill climbing> and I<use_skill climbing>.
		1843
		1844	You can abbreviate commands by typing only the first character of every
		1845	word (or even characters within the word - the client will try to make
		1846	a good guess, as long as the characters are in order). For example,
		1847	typing I<iwor> will likely select I<invoke word of recall>, while I<ccfo>
		1848	will select I<cast create food>. Likewise, I<rscli> will likely select
		1849	I<ready_skill climbing> and I<usl> will give you I<use_skill levitation>.
		1850
		1851	You can enter space and other text as arguemnt to the command. For
		1852	example, C<cfoo waybread> will expand to C<cast create food waybread>.
		1853
		1854	=head2 The map overview
		1855
		1856	#TODO#
		1857
		1858	=head2 The Status area in the lower right corner
		1859
		1860	#TODO#
		1861
		1862	=head2 The I<Statistics>/I>Stats> window
		1863
		1864	#TODO#
		1865
		1866	=head1 FAQ
		1867
		1868	=over 4
		1869
		1870	=item The client is very sluggish and slow, what can I do about this?
		1871
		1872	Most likely, you don't have accelerated OpenGL support. Try to find a
		1873	newer driver, or a driver from your hardware vendor, that features OpenGL
		1874	support.
		1875
		1876	If this is not an option, the following Setup options reduce the load and
		1877	will likely make the client playable with sofwtare rendering (it will
		1878	still be slow, though):
		1879
		1880	=over 4
		1881
		1882	=item B<Video Mode> should be set as low as possible (e.g. 640x480)
		1883
		1884	=item Enable B<Fast & Ugly> mode
		1885
		1886	=item Disable B<Fog of War>
		1887
		1888	=item Increase B<Map Scale>
		1889
		1890	=back
		1891
		1892	=back
		1893
		1894	=head1 AUTHOR
		1895
		1896	Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
		1897
		1898
		1899

Diff Legend

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