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.158 by elmex, Sat Apr 22 12:14:45 2006 UTC vs.
Revision 1.223 by elmex, Wed May 17 14:55:15 2006 UTC

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

Diff Legend

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