ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/deliantra/Deliantra-Client/bin/cfplus

Comparing deliantra/Deliantra-Client/bin/cfplus (file contents):
Revision 1.2 by root, Thu May 25 16:35:42 2006 UTC vs.
Revision 1.57 by root, Mon Jun 5 21:10:04 2006 UTC

…		…
25	# 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
26	unshift @INC, $ENV{PAR_TEMP}	26	unshift @INC, $ENV{PAR_TEMP}
27	if %PAR::LibCache;	27	if %PAR::LibCache;
28		28
29	use Time::HiRes 'time';	29	use Time::HiRes 'time';
30	use Pod::POM;
31	use Event;	30	use Event;
32		31
33	use Crossfire;	32	use Crossfire;
34	use Crossfire::Protocol;	33	use Crossfire::Protocol::Constants;
35		34
36	use Compress::LZF;	35	use Compress::LZF;
37		36
38	use CFClient;	37	use CFClient;
		38	use CFClient::OpenGL ();
		39	use CFClient::Protocol;
39	use CFClient::UI;	40	use CFClient::UI;
40	use CFClient::MapWidget;	41	use CFClient::MapWidget;
41		42
42	$Event::DIED = sub {	43	$Event::DIED = sub {
43	# TODO: display dialog box or so	44	# TODO: display dialog box or so
		45	Carp::confess $_[1];#d#TODO: remove when stable
44	CFClient::error $_[1];	46	CFClient::error $_[1];
45	};	47	};
46		48
47	#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#	49	#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#
48		50
…		…
50		52
51	my $MAX_FPS = 60;	53	my $MAX_FPS = 60;
52	my $MIN_FPS = 5; # unused as of yet	54	my $MIN_FPS = 5; # unused as of yet
53		55
54	our $META_SERVER = "crossfire.real-time.com:13326";	56	our $META_SERVER = "crossfire.real-time.com:13326";
55
56	our $FACEMAP;
57	our $TILECACHE;
58	our $MAPCACHE;
59		57
60	our $LAST_REFRESH;	58	our $LAST_REFRESH;
61	our $NOW;	59	our $NOW;
62		60
63	our $CFG;	61	our $CFG;
…		…
83	our $LOGVIEW;	81	our $LOGVIEW;
84	our $CONSOLE;	82	our $CONSOLE;
85	our $METASERVER;	83	our $METASERVER;
86	our $LOGIN_BUTTON;	84	our $LOGIN_BUTTON;
87	our $QUIT_DIALOG;	85	our $QUIT_DIALOG;
		86	our $HOST_ENTRY;
		87
		88	our $SETUP_DIALOG;
		89	our $SETUP_NOTEBOOK;
		90	our $SETUP_SERVER;
		91	our $SETUP_KEYBOARD;
		92	our $SETUP_SPELLS;
88		93
89	our $FLOORBOX;	94	our $FLOORBOX;
90	our $GAUGES;	95	our $GAUGES;
91	our $STATWIDS;	96	our $STATWIDS;
92		97
…		…
99		104
100	our $ALT_ENTER_MESSAGE;	105	our $ALT_ENTER_MESSAGE;
101	our $STATUSBOX;	106	our $STATUSBOX;
102	our $DEBUG_STATUS;	107	our $DEBUG_STATUS;
103		108
104	our $INVWIN;	109	our $INV_WINDOW;
105	our $INV;	110	our $INV;
106	our $INVR;	111	our $INVR;
107	our $INVR_LBL;	112	our $INV_RIGHT_HB;
108	our $OPENCONT;	113
		114	our $BIND_EDITOR;
		115
		116	our $PICKUP_CFG;
109		117
110	sub status {	118	sub status {
111	$STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);	119	$STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
112	}	120	}
113		121
114	sub debug {	122	sub debug {
115	$DEBUG_STATUS->set_text ($_[0]);	123	$DEBUG_STATUS->set_text ($_[0]);
116	my ($w, $h) = $DEBUG_STATUS->size_request;
117	$DEBUG_STATUS->move ($WIDTH - $w, 0);
118	}	124	}
119		125
120	sub start_game {	126	sub start_game {
121	status "logging in...";	127	status "logging in...";
122		128
		129	$LOGIN_BUTTON->set_text ("Logout");
		130	$SETUP_DIALOG->hide;
		131
123	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;	132	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
124		133
125	$MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";	134	my ($host, $port) = split /:/, $CFG->{host};
		135
126	$MAP = new CFClient::Map $mapsize, $mapsize;	136	$MAP = new CFClient::Map $mapsize, $mapsize;
127
128	my ($host, $port) = split /:/, $CFG->{host};
129		137
130	$CONN = eval {	138	$CONN = eval {
131	new conn	139	new CFClient::Protocol
132	host => $host,	140	host => $host,
133	port => $port || 13327,	141	port => $port || 13327,
134	user => $CFG->{user},	142	user => $CFG->{user},
135	pass => $CFG->{password},	143	pass => $CFG->{password},
136	mapw => $mapsize,	144	mapw => $mapsize,
137	maph => $mapsize,	145	maph => $mapsize,
138	;	146
		147	map_widget => $MAPWIDGET,
		148	logview => $LOGVIEW,
		149	statusbox => $STATUSBOX,
		150	map => $MAP,
		151	mapmap => $MAPMAP,
		152
		153	sound_play => sub {
		154	my ($x, $y, $soundnum, $type) = @_;
		155
		156	$SDL_MIXER
		157	or return;
		158
		159	my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
		160	or return;
		161
		162	$chunk->play;
		163	},
139	};	164	};
140		165
141	if ($CONN) {	166	if ($CONN) {
142	CFClient::lowdelay fileno $CONN->{fh};	167	CFClient::lowdelay fileno $CONN->{fh};
143		168
144	$LOGIN_BUTTON->set_text ("Logout");
145	status "login successful";	169	status "login successful";
146
147	$BUTTONBAR->{children}[1]->emit ("activate")
148	if $BUTTONBAR->{children}[1]->{state};
149
150	} else {	170	} else {
151	status "unable to connect";	171	status "unable to connect";
152	stop_game();	172	stop_game();
153	}	173	}
154	}	174	}
155		175
156	sub stop_game {	176	sub stop_game {
		177	$LOGIN_BUTTON->set_text ("Login");
		178	$SETUP_NOTEBOOK->set_current_page ($SETUP_SERVER);
		179	$SETUP_DIALOG->show;
		180	$INV_WINDOW->hide;
		181
157	return unless $CONN;	182	return unless $CONN;
158		183
159	status "connection closed";	184	status "connection closed";
160	$LOGIN_BUTTON->set_text ("Login");	185
161	$CONN->destroy;	186	$CONN->destroy;
162	$CONN = 0; # false, does not autovivify	187	$CONN = 0; # false, does not autovivify
163
164	$BUTTONBAR->{children}[1]->emit ("activate")
165	unless $BUTTONBAR->{children}[1]->{state};
166
167	undef $MAPCACHE;
168	undef $MAP;
169	}	188	}
170		189
171	sub client_setup {	190	sub graphics_setup {
172	my $dialog = new CFClient::UI::FancyFrame
173	title => "Client Setup",
174	child => (my $vbox = new CFClient::UI::VBox);	191	my $vbox = new CFClient::UI::VBox;
		192
175	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);	193	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
176		194
177	$table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");	195	$table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");
178	$table->add (1, 0, my $hbox = new CFClient::UI::HBox);	196	$table->add (1, 0, my $hbox = new CFClient::UI::HBox);
179		197
180	$hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1]);	198	$hbox->add (my $mode_slider = new CFClient::UI::Slider force_w => $WIDTH * 0.1, expand => 1, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1]);
181	$hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");	199	$hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");
182		200
183	$mode_slider->connect (changed => sub {	201	$mode_slider->connect (changed => sub {
184	my ($self, $value) = @_;	202	my ($self, $value) = @_;
185		203
…		…
192		210
193	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");	211	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
194	$table->add (1, $row++, new CFClient::UI::CheckBox	212	$table->add (1, $row++, new CFClient::UI::CheckBox
195	state => $CFG->{fullscreen},	213	state => $CFG->{fullscreen},
196	tooltip => "Bring the client into fullscreen mode.",	214	tooltip => "Bring the client into fullscreen mode.",
197	connect_changed => sub {	215	on_changed => sub {
198	my ($self, $value) = @_;	216	my ($self, $value) = @_;
199	$CFG->{fullscreen} = $value;	217	$CFG->{fullscreen} = $value;
200	}	218	}
201	);	219	);
202		220
203	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");	221	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
204	$table->add (1, $row++, new CFClient::UI::CheckBox	222	$table->add (1, $row++, new CFClient::UI::CheckBox
205	state => $CFG->{fast},	223	state => $CFG->{fast},
206	tooltip => "Lower the visual quality considerably to speed up rendering.",	224	tooltip => "Lower the visual quality considerably to speed up rendering.",
207	connect_changed => sub {	225	on_changed => sub {
208	my ($self, $value) = @_;	226	my ($self, $value) = @_;
209	$CFG->{fast} = $value;	227	$CFG->{fast} = $value;
210	}	228	}
211	);	229	);
212		230
213	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");	231	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
214	$table->add (1, $row++, new CFClient::UI::Slider	232	$table->add (1, $row++, new CFClient::UI::Slider
215	range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],	233	range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
216	tooltip => "Enlarge or shrink the displayed map. Changes are instant.",	234	tooltip => "Enlarge or shrink the displayed map. Changes are instant.",
217	connect_changed => sub {	235	on_changed => sub {
218	my ($self, $value) = @_;	236	my ($self, $value) = @_;
219	$CFG->{map_scale} = 2 ** $value;	237	$CFG->{map_scale} = 2 ** $value;
220	}	238	}
221	);	239	);
222		240
223	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");	241	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
224	$table->add (1, $row++, new CFClient::UI::CheckBox	242	$table->add (1, $row++, new CFClient::UI::CheckBox
225	state => $CFG->{fow_enable},	243	state => $CFG->{fow_enable},
226	tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",	244	tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",
227	connect_changed => sub {	245	on_changed => sub {
228	my ($self, $value) = @_;	246	my ($self, $value) = @_;
229	$CFG->{fow_enable} = $value;	247	$CFG->{fow_enable} = $value;
230	}	248	}
231	);	249	);
232		250
233	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");	251	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
234	$table->add (1, $row++, new CFClient::UI::Slider	252	$table->add (1, $row++, new CFClient::UI::Slider
235	range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],	253	range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],
236	tooltip => "<b>Fog of War Lightness.</b> The higher the intensity, the lighter the Fog-of-War color. Changes are instant.",	254	tooltip => "<b>Fog of War Lightness.</b> The higher the intensity, the lighter the Fog-of-War color. Changes are instant.",
237	connect_changed => sub {	255	on_changed => sub {
238	my ($self, $value) = @_;	256	my ($self, $value) = @_;
239	$CFG->{fow_intensity} = $value;	257	$CFG->{fow_intensity} = $value;
240	}	258	}
241	);	259	);
242		260
243	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");	261	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
244	$table->add (1, $row++, new CFClient::UI::CheckBox	262	$table->add (1, $row++, new CFClient::UI::CheckBox
245	state => $CFG->{fow_smooth},	263	state => $CFG->{fow_smooth},
246	tooltip => "Smooth the Fog-of-War a bit to make it more realistic. Changes are instant.",	264	tooltip => "Smooth the Fog-of-War a bit to make it more realistic. Changes are instant.",
247	connect_changed => sub {	265	on_changed => sub {
248	my ($self, $value) = @_;	266	my ($self, $value) = @_;
249	$CFG->{fow_smooth} = $value;	267	$CFG->{fow_smooth} = $value;
250	status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2;	268	status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::OpenGL::GL_VERSION < 1.2;
251	}	269	}
252	);	270	);
253		271
254	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");	272	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
255	$table->add (1, $row++, new CFClient::UI::Slider	273	$table->add (1, $row++, new CFClient::UI::Slider
256	range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],	274	range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],
257	tooltip => "The base font size used by most GUI elements that do not have their own setting.",	275	tooltip => "The base font size used by most GUI elements that do not have their own setting.",
258	connect_changed => sub { $CFG->{gui_fontsize} = $_[1] },	276	on_changed => sub { $CFG->{gui_fontsize} = $_[1] },
259	);	277	);
260		278
261	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Message Fontsize");	279	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Message Fontsize");
262	$table->add (1, $row++, new CFClient::UI::Slider	280	$table->add (1, $row++, new CFClient::UI::Slider
263	range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],	281	range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],
264	tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant.",	282	tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant.",
265	connect_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]) },	283	on_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]) },
266	);	284	);
267		285
268	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");	286	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
269		287
270	$table->add (1, $row++, new CFClient::UI::Slider	288	$table->add (1, $row++, new CFClient::UI::Slider
271	range => [$CFG->{stat_fontsize}, 0.5, 2, 0, 0.1],	289	range => [$CFG->{stat_fontsize}, 0.5, 2, 0, 0.1],
272	tooltip => "The font size used by the <b>statistics window</b> only. Changes are instant.",	290	tooltip => "The font size used by the <b>statistics window</b> only. Changes are instant.",
273	connect_changed => sub {	291	on_changed => sub {
274	$CFG->{stat_fontsize} = $_[1];	292	$CFG->{stat_fontsize} = $_[1];
275	&set_stats_window_fontsize;	293	&set_stats_window_fontsize;
276	}	294	}
277	);	295	);
278		296
279	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");	297	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
280	$table->add (1, $row++, new CFClient::UI::Slider	298	$table->add (1, $row++, new CFClient::UI::Slider
281	range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],	299	range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],
282	tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.",	300	tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.",
283	connect_changed => sub {	301	on_changed => sub {
284	$CFG->{gauge_fontsize} = $_[1];	302	$CFG->{gauge_fontsize} = $_[1];
285	&set_gauge_window_fontsize;	303	&set_gauge_window_fontsize;
286	}	304	}
287	);	305	);
288		306
289	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");	307	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
290	$table->add (1, $row++, new CFClient::UI::Slider	308	$table->add (1, $row++, new CFClient::UI::Slider
291	range => [$CFG->{gauge_size}, 0.2, 0.8],	309	range => [$CFG->{gauge_size}, 0.2, 0.8],
292	tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",	310	tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",
293	connect_changed => sub {	311	on_changed => sub {
294	$CFG->{gauge_size} = $_[1];	312	$CFG->{gauge_size} = $_[1];
295	$GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});	313	$GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
296	}	314	}
297	);	315	);
298		316
299	$table->add (1, $row++, new CFClient::UI::Button	317	$table->add (1, $row++, new CFClient::UI::Button
300	expand => 1, align => 0, text => "Apply",	318	expand => 1, align => 0, text => "Apply",
301	tooltip => "Apply the video settings",	319	tooltip => "Apply the video settings",
302	connect_activate => sub {	320	on_activate => sub {
303	video_shutdown ();	321	video_shutdown ();
304	video_init ();	322	video_init ();
305	}	323	}
306	);	324	);
		325
		326	$vbox
		327	}
		328
		329	sub audio_setup {
		330	my $vbox = new CFClient::UI::VBox;
		331
		332	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
		333
		334	my $row = 0;
307		335
308	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");	336	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");
309	$table->add (1, $row++, new CFClient::UI::CheckBox	337	$table->add (1, $row++, new CFClient::UI::CheckBox
310	state => $CFG->{audio_enable},	338	state => $CFG->{audio_enable},
311	tooltip => "<b>Master Audio Enable.</b> If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.",	339	tooltip => "<b>Master Audio Enable.</b> If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.",
312	connect_changed => sub {	340	on_changed => sub {
313	$CFG->{audio_enable} = $_[1];	341	$CFG->{audio_enable} = $_[1];
314	}	342	}
315	);	343	);
316	# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume");	344	# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume");
317	# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], connect_changed => sub {	345	# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], on_changed => sub {
318	# $CFG->{effects_volume} = $_[1];	346	# $CFG->{effects_volume} = $_[1];
319	# });	347	# });
320	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");	348	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");
321	$table->add (1, $row++, my $hbox = new CFClient::UI::HBox);	349	$table->add (1, $row++, my $hbox = new CFClient::UI::HBox);
322	$hbox->add (new CFClient::UI::CheckBox	350	$hbox->add (new CFClient::UI::CheckBox
323	expand => 1, state => $CFG->{bgm_enable},	351	expand => 1, state => $CFG->{bgm_enable},
324	tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",	352	tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",
325	connect_changed => sub {	353	on_changed => sub {
326	$CFG->{bgm_enable} = $_[1];	354	$CFG->{bgm_enable} = $_[1];
327	}	355	}
328	);	356	);
329	$hbox->add (new CFClient::UI::Slider	357	$hbox->add (new CFClient::UI::Slider
330	expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],	358	expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],
331	tooltip => "The volume of the background music. Changes are instant.",	359	tooltip => "The volume of the background music. Changes are instant.",
332	connect_changed => sub {	360	on_changed => sub {
333	$CFG->{bgm_volume} = $_[1];	361	$CFG->{bgm_volume} = $_[1];
334	CFClient::MixMusic::volume $_[1] * 128;	362	CFClient::MixMusic::volume $_[1] * 128;
335	}	363	}
336	);	364	);
337		365
338	$table->add (1, $row++, new CFClient::UI::Button	366	$table->add (1, $row++, new CFClient::UI::Button
339	expand => 1, align => 0, text => "Apply",	367	expand => 1, align => 0, text => "Apply",
340	tooltip => "Apply the audio settings",	368	tooltip => "Apply the audio settings",
341	connect_activate => sub {	369	on_activate => sub {
342	audio_shutdown ();	370	audio_shutdown ();
343	audio_init ();	371	audio_init ();
344	}	372	}
345	);	373	);
346		374
347	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Chat Command");	375	$vbox
348	$table->add (1, $row++, my $saycmd = new CFClient::UI::Entry
349	text => $CFG->{say_command},
350	tooltip => "This is the command that will be used if you write a line in the message window entry or press <b>\"</b> in the map window. "
351	. "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
352	. "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
353	connect_changed => sub {
354	my ($self, $value) = @_;
355	$CFG->{say_command} = $value;
356	}
357	);
358
359	$dialog
360	}	376	}
361		377
362	sub set_stats_window_fontsize {	378	sub set_stats_window_fontsize {
363	for (values %{$STATWIDS}) {	379	for (values %{$STATWIDS}) {
364	$_->set_fontsize ($::CFG->{stat_fontsize});	380	$_->set_fontsize ($::CFG->{stat_fontsize});
…		…
373		389
374	sub make_gauge_window {	390	sub make_gauge_window {
375	my $gh = int $HEIGHT * $CFG->{gauge_size};	391	my $gh = int $HEIGHT * $CFG->{gauge_size};
376		392
377	my $win = new CFClient::UI::Frame (	393	my $win = new CFClient::UI::Frame (
378	req_y => -1,	394	force_x => 0,
		395	force_y => "max",
379	user_w => $WIDTH,	396	force_w => $WIDTH,
380	user_h => $gh,	397	force_h => $gh,
381	);	398	);
382		399
383	$win->add (my $hbox = new CFClient::UI::HBox	400	$win->add (my $hbox = new CFClient::UI::HBox
384	children => [	401	children => [
385	(new CFClient::UI::HBox expand => 1),	402	(new CFClient::UI::HBox expand => 1),
…		…
421	&set_gauge_window_fontsize;	438	&set_gauge_window_fontsize;
422		439
423	$win	440	$win
424	}	441	}
425		442
		443
426	sub make_stats_window {	444	sub make_stats_window {
427	my $tgw = new CFClient::UI::FancyFrame title => "Stats";	445	my $tgw = new CFClient::UI::FancyFrame
		446	y => $HEIGHT * (2/8),
		447	x => "max",
		448	title => "Stats",
		449	name => "stats_window";
428		450
429	$tgw->add (new CFClient::UI::Window child => my $vb = new CFClient::UI::VBox);	451	$tgw->add (new CFClient::UI::Window child => my $vb = new CFClient::UI::VBox);
430	$vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,	452	$vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,
431	can_hover => 1, can_events => 1,	453	can_hover => 1, can_events => 1,
432	tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");	454	tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");
433	$vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,	455	$vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,
434	can_hover => 1, can_events => 1,	456	can_hover => 1, can_events => 1,
435	tooltip => "The map you are currently on (if supported by the server).");	457	tooltip => "The map you are currently on (if supported by the server).");
		458
		459	$vb->add (my $hb0 = new CFClient::UI::HBox);
		460	$hb0->add ($STATWIDS->{weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1,
		461	can_hover => 1, can_events => 1,
		462	tooltip => "The weight of the player including all inventory items.");
		463	$hb0->add ($STATWIDS->{m_weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1,
		464	can_hover => 1, can_events => 1,
		465	tooltip => "The weight limit: you cannot carry more than this.");
		466
436		467
437	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);	468	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
438	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);	469	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);
439		470
440	my $color2 = [1, 1, 0];	471	my $color2 = [1, 1, 0];
…		…
522	update_stats_window ({});	553	update_stats_window ({});
523		554
524	$tgw	555	$tgw
525	}	556	}
526		557
527	sub formsep {	558	sub formsep($) {
528	reverse join ",", grep length, split /(...)/, reverse $_[0] * 1	559	scalar reverse join ",", unpack "(A3)*", reverse $_[0] * 1
529	}	560	}
530		561
531	sub update_stats_window {	562	sub update_stats_window {
532	my ($stats) = @_;	563	my ($stats) = @_;
533		564
534	# i love text protocols!!!	565	# I love text protocols...
		566
535	my $hp = $stats->{Crossfire::Protocol::CS_STAT_HP} * 1;	567	my $hp = $stats->{+CS_STAT_HP} * 1;
536	my $hp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXHP} * 1;	568	my $hp_m = $stats->{+CS_STAT_MAXHP} * 1;
537	my $sp = $stats->{Crossfire::Protocol::CS_STAT_SP} * 1;	569	my $sp = $stats->{+CS_STAT_SP} * 1;
538	my $sp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXSP} * 1;	570	my $sp_m = $stats->{+CS_STAT_MAXSP} * 1;
539	my $fo = $stats->{Crossfire::Protocol::CS_STAT_FOOD} * 1;	571	my $fo = $stats->{+CS_STAT_FOOD} * 1;
540	my $fo_m = 999;	572	my $fo_m = 999;
541	my $gr = $stats->{Crossfire::Protocol::CS_STAT_GRACE} * 1;	573	my $gr = $stats->{+CS_STAT_GRACE} * 1;
542	my $gr_m = $stats->{Crossfire::Protocol::CS_STAT_MAXGRACE} * 1;	574	my $gr_m = $stats->{+CS_STAT_MAXGRACE} * 1;
543		575
544	$GAUGES->{hp} ->set_value ($hp, $hp_m);	576	$GAUGES->{hp} ->set_value ($hp, $hp_m);
545	$GAUGES->{mana} ->set_value ($sp, $sp_m);	577	$GAUGES->{mana} ->set_value ($sp, $sp_m);
546	$GAUGES->{food} ->set_value ($fo, $fo_m);	578	$GAUGES->{food} ->set_value ($fo, $fo_m);
547	$GAUGES->{grace} ->set_value ($gr, $gr_m);	579	$GAUGES->{grace} ->set_value ($gr, $gr_m);
548	$GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::CS_STAT_EXP64})	580	$GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{+CS_STAT_EXP64})
549	. " (lvl " . ($stats->{Crossfire::Protocol::CS_STAT_LEVEL} * 1) . ")");	581	. " (lvl " . ($stats->{+CS_STAT_LEVEL} * 1) . ")");
550	my $rng = $stats->{Crossfire::Protocol::CS_STAT_RANGE};	582	my $rng = $stats->{+CS_STAT_RANGE};
551	$rng =~ s/^Range: //; # thank you so much dear server	583	$rng =~ s/^Range: //; # thank you so much dear server
552	$GAUGES->{range} ->set_text ("Rng: " . $rng);	584	$GAUGES->{range} ->set_text ("Rng: " . $rng);
553	my $title = $stats->{Crossfire::Protocol::CS_STAT_TITLE};	585	my $title = $stats->{+CS_STAT_TITLE};
554	$title =~ s/^Player: //;	586	$title =~ s/^Player: //;
555	$STATWIDS->{title} ->set_text ("Title: " . $title);	587	$STATWIDS->{title} ->set_text ("Title: " . $title);
556		588
557	$STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});	589	$STATWIDS->{st_str} ->set_text (sprintf "%d" , $stats->{+CS_STAT_STR});
558	$STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});	590	$STATWIDS->{st_dex} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DEX});
559	$STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9});	591	$STATWIDS->{st_con} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CON});
560	$STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6});	592	$STATWIDS->{st_int} ->set_text (sprintf "%d" , $stats->{+CS_STAT_INT});
561	$STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7});	593	$STATWIDS->{st_wis} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WIS});
562	$STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22});	594	$STATWIDS->{st_pow} ->set_text (sprintf "%d" , $stats->{+CS_STAT_POW});
563	$STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});	595	$STATWIDS->{st_cha} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CHA});
564	$STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13});	596	$STATWIDS->{st_wc} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WC});
565	$STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14});	597	$STATWIDS->{st_ac} ->set_text (sprintf "%d" , $stats->{+CS_STAT_AC});
566	$STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});	598	$STATWIDS->{st_dam} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DAM});
567	$STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});	599	$STATWIDS->{st_arm} ->set_text (sprintf "%d" , $stats->{+CS_STAT_ARMOUR});
568	$STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_SPEED});	600	$STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{+CS_STAT_SPEED});
569	$STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_WEAP_SP});	601	$STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{+CS_STAT_WEAP_SP});
570		602
		603	$STATWIDS->{m_weight}->set_text (sprintf "Max weight: %.1fkg", $stats->{+CS_STAT_WEIGHT_LIM} / 1000);
		604
		605	# TODO: replace by CS_STAT_RES_xxx constants
571	my %tbl = (	606	my %tbl = (
572	phys => 100,	607	phys => 100,
573	magic => 101,	608	magic => 101,
574	fire => 102,	609	fire => 102,
575	elec => 103,	610	elec => 103,
…		…
584	tund => 112,	619	tund => 112,
585	fear => 113,	620	fear => 113,
586	depl => 113,	621	depl => 113,
587	deat => 115,	622	deat => 115,
588	holyw => 116,	623	holyw => 116,
589	blind => 117	624	blind => 117,
590	);	625	);
591		626
592	for (keys %tbl) {
593	$STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}});	627	$STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}})
594	}	628	for keys %tbl;
595
596	}
597
598	sub metaserver_dialog {
599	my $dialog = new CFClient::UI::FancyFrame
600	title => "Server List",
601	child => (my $vbox = new CFClient::UI::VBox);
602
603	$vbox->add ($dialog->{table} = new CFClient::UI::Table);
604
605	$dialog
606	}	629	}
607		630
608	my $METASERVER_ATIME;	631	my $METASERVER_ATIME;
609		632
610	sub update_metaserver {	633	sub update_metaserver {
611	my ($HOST) = @_;
612
613	return if $METASERVER_ATIME > time;	634	return if $METASERVER_ATIME > time;
614	$METASERVER_ATIME = time + 60;	635	$METASERVER_ATIME = time + 60;
615		636
616	my $table = $METASERVER->{table};	637	my $table = $METASERVER->{table};
617	$table->clear;	638	$table->clear;
…		…
668	$m = [$users, $host, $uptime, $version, $desc];	689	$m = [$users, $host, $uptime, $version, $desc];
669		690
670	$y++;	691	$y++;
671		692
672	$table->add (0, $y, new CFClient::UI::VBox children => [	693	$table->add (0, $y, new CFClient::UI::VBox children => [
673	(new CFClient::UI::Button text => "Use", connect_activate => sub {	694	(new CFClient::UI::Button text => "Use", on_activate => sub {
674	$HOST->set_text ($CFG->{host} = $host);	695	$HOST_ENTRY->set_text ($CFG->{host} = $host);
		696	$METASERVER->toggle_visibility;
675	}),	697	}),
676	(new CFClient::UI::Empty expand => 1),	698	(new CFClient::UI::Empty expand => 1),
677	]);	699	]);
678		700
679	$table->add ($_ + 1, $y, new CFClient::UI::Label	701	$table->add ($_ + 1, $y, new CFClient::UI::Label
…		…
682	}	704	}
683	}	705	}
684	});	706	});
685	}	707	}
686		708
		709	sub metaserver_dialog {
		710	my $dialog = new CFClient::UI::FancyFrame
		711	title => "Server List",
		712	name => 'metaserver_dialog',
		713	x => 'center',
		714	y => 'center',
		715	z => 3,
		716	child => (my $vbox = new CFClient::UI::VBox),
		717	on_visibility_change => sub {
		718	update_metaserver if $_[1];
		719	},
		720	;
		721
		722	$vbox->add ($dialog->{table} = new CFClient::UI::Table);
		723
		724	$dialog
		725	}
		726
687	sub server_setup {	727	sub server_setup {
688	my $dialog = new CFClient::UI::FancyFrame
689	title => "Server Setup",
690	child => (my $vbox = new CFClient::UI::VBox);	728	my $vbox = new CFClient::UI::VBox;
691		729
692	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);	730	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
693	$table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");	731	$table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
694		732
695	{	733	{
696	$table->add (1, 2, my $vbox = new CFClient::UI::VBox);	734	$table->add (1, 2, my $vbox = new CFClient::UI::VBox);
697		735
698	$vbox->add (	736	$vbox->add (
699	my $HOST = new CFClient::UI::Entry	737	$HOST_ENTRY = new CFClient::UI::Entry
700	expand => 1,	738	expand => 1,
701	text => $CFG->{host},	739	text => $CFG->{host},
702	tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",	740	tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
703	connect_changed => sub {	741	on_changed => sub {
704	my ($self, $value) = @_;	742	my ($self, $value) = @_;
705	$CFG->{host} = $value;	743	$CFG->{host} = $value;
706	}	744	}
707	);	745	);
708		746
709	$METASERVER = metaserver_dialog;	747	$METASERVER = metaserver_dialog;
710		748
711	$vbox->add (new CFClient::UI::Flopper	749	$vbox->add (new CFClient::UI::Button
712	expand => 1,	750	expand => 1,
713	text => "Server List",	751	text => "Server List",
714	other => $METASERVER,	752	other => $METASERVER,
715	tooltip => "Show a list of available crossfire servers",	753	tooltip => "Show a list of available crossfire servers",
716	connect_open => sub {	754	on_activate => sub { $METASERVER->toggle_visibility },
717	update_metaserver $HOST;
718	}
719	);	755	);
720	}	756	}
721		757
722	$table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");	758	$table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
723	$table->add (1, 4, new CFClient::UI::Entry	759	$table->add (1, 4, new CFClient::UI::Entry
724	text => $CFG->{user},	760	text => $CFG->{user},
725	tooltip => "The name of your character on the server",	761	tooltip => "The name of your character on the server",
726	connect_changed => sub {	762	on_changed => sub {
727	my ($self, $value) = @_;	763	my ($self, $value) = @_;
728	$CFG->{user} = $value;	764	$CFG->{user} = $value;
729	}	765	}
730	);	766	);
731		767
732	$table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");	768	$table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
733	$table->add (1, 5, new CFClient::UI::Entry	769	$table->add (1, 5, new CFClient::UI::Entry
734	text => $CFG->{password},	770	text => $CFG->{password},
735	hidden => 1,	771	hidden => 1,
736	tooltip => "The password for your character",	772	tooltip => "The password for your character",
737	connect_changed => sub {	773	on_changed => sub {
738	my ($self, $value) = @_;	774	my ($self, $value) = @_;
739	$CFG->{password} = $value;	775	$CFG->{password} = $value;
740	}	776	}
741	);	777	);
742		778
743	$table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");	779	$table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
744	$table->add (1, 7, new CFClient::UI::Slider	780	$table->add (1, 7, new CFClient::UI::Slider
745	req_w => 100,	781	force_w => 100,
746	range => [$CFG->{mapsize}, 10, 100, 0, 1],	782	range => [$CFG->{mapsize}, 10, 100, 0, 1],
747	tooltip => "This is the size of the portion of the map update the server sends you. "	783	tooltip => "This is the size of the portion of the map update the server sends you. "
748	. "If you set this to a high value you will be able to see further, "	784	. "If you set this to a high value you will be able to see further, "
749	. "but you also increase bandwidth requirements and latency. "	785	. "but you also increase bandwidth requirements and latency. "
750	. "This option is only used once at log-in.",	786	. "This option is only used once at log-in.",
751	connect_changed => sub {	787	on_changed => sub {
752	my ($self, $value) = @_;	788	my ($self, $value) = @_;
753		789
754	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;	790	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;
755	},	791	},
756	);	792	);
…		…
763	. "This might increase or create lag, but increases the chances "	799	. "This might increase or create lag, but increases the chances "
764	. "of faces being ready for display when you encounter them. "	800	. "of faces being ready for display when you encounter them. "
765	. "It also uses up server bandwidth on every connect, "	801	. "It also uses up server bandwidth on every connect, "
766	. "so only set it if you really need to prefetch images. "	802	. "so only set it if you really need to prefetch images. "
767	. "This option can be set and unset any time.",	803	. "This option can be set and unset any time.",
768	connect_changed => sub { $CFG->{face_prefetch} = $_[1] },	804	on_changed => sub { $CFG->{face_prefetch} = $_[1] },
769	);	805	);
770		806
771	$table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");	807	$table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");
772	$table->add (1, 9, new CFClient::UI::Entry	808	$table->add (1, 9, new CFClient::UI::Entry
773	text => $CFG->{output_count},	809	text => $CFG->{output_count},
774	tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",	810	tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
775	connect_changed => sub { $CFG->{output_count} = $_[1] },	811	on_changed => sub { $CFG->{output_count} = $_[1] },
776	);	812	);
777		813
778	$table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");	814	$table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");
779	$table->add (1, 10, new CFClient::UI::Entry	815	$table->add (1, 10, new CFClient::UI::Entry
780	text => $CFG->{output_sync},	816	text => $CFG->{output_sync},
781	tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",	817	tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
782	connect_changed => sub { $CFG->{output_sync} = $_[1] },	818	on_changed => sub { $CFG->{output_sync} = $_[1] },
783	);	819	);
784		820
785	$table->add (1, 11, $LOGIN_BUTTON = new CFClient::UI::Button	821	$table->add (1, 11, $LOGIN_BUTTON = new CFClient::UI::Button
786	expand => 1,	822	expand => 1,
787	align => 0,	823	align => 0,
788	text => "Login",	824	text => "Login",
789	connect_activate => sub {	825	on_activate => sub {
790	$CONN ? stop_game	826	$CONN ? stop_game
791	: start_game;	827	: start_game;
792	},	828	},
793	);	829	);
794		830
795	$dialog	831	$table->add (0, 12, new CFClient::UI::Label valign => 0, align => 1, text => "Chat Command");
		832	$table->add (1, 12, my $saycmd = new CFClient::UI::Entry
		833	text => $CFG->{say_command},
		834	tooltip => "This is the command that will be used if you write a line in the message window entry or press <b>\"</b> in the map window. "
		835	. "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
		836	. "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
		837	on_changed => sub {
		838	my ($self, $value) = @_;
		839	$CFG->{say_command} = $value;
		840	}
		841	);
		842
		843	$vbox
796	}	844	}
797		845
798	sub message_window {	846	sub message_window {
799	my $window = new CFClient::UI::FancyFrame	847	my $window = new CFClient::UI::FancyFrame
		848	name => "message_window",
800	title => "Messages",	849	title => "Messages",
801	border_bg => [1, 1, 1, 1],	850	border_bg => [1, 1, 1, 1],
802	bg => [0, 0, 0, 0.75],	851	bg => [0, 0, 0, 0.75],
		852	x => "max",
		853	y => 0,
803	user_w => int $::WIDTH / 3,	854	force_w => $::WIDTH / 3,
804	user_h => int $::HEIGHT / 5,	855	force_h => $::HEIGHT / 5,
805	child => (my $vbox = new CFClient::UI::VBox);	856	child => (my $vbox = new CFClient::UI::VBox);
806		857
807	$vbox->add ($LOGVIEW);	858	$vbox->add ($LOGVIEW);
808		859
809	$vbox->add (my $input = new CFClient::UI::Entry	860	$vbox->add (my $input = new CFClient::UI::Entry
810	tooltip => "<b>Chat Box</b>. If you enter a text and press return/enter here, the current <i>communication command</i> "	861	tooltip => "<b>Chat Box</b>. If you enter a text and press return/enter here, the current <i>communication command</i> "
811	. "from the client setup will be prepended (e.g. <b>shout</b>, <b>chat</b>...). "	862	. "from the client setup will be prepended (e.g. <b>shout</b>, <b>chat</b>...). "
812	. "If you prepend a slash (/), you will submit a command instead (similar to IRC). "	863	. "If you prepend a slash (/), you will submit a command instead (similar to IRC). "
813	. "A better way to submit commands (and the occasional chat command) is often the map command completer.",	864	. "A better way to submit commands (and the occasional chat command) is often the map command completer.",
814	connect_focus_in => sub {	865	on_focus_in => sub {
815	my ($input, $prev_focus) = @_;	866	my ($input, $prev_focus) = @_;
816		867
817	delete $input->{refocus_map};	868	delete $input->{refocus_map};
818		869
819	if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {	870	if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
820	$input->{refocus_map} = 1;	871	$input->{refocus_map} = 1;
821	}	872	}
822	delete $input->{auto_activated};	873	delete $input->{auto_activated};
823	},	874	},
824	connect_activate => sub {	875	on_activate => sub {
825	my ($input, $text) = @_;	876	my ($input, $text) = @_;
826	$input->set_text ('');	877	$input->set_text ('');
827		878
828	if ($text =~ /^\/(.*)/) {	879	if ($text =~ /^\/(.*)/) {
829	$::CONN->user_send ($1);	880	$::CONN->user_send ($1);
…		…
834	if ($input->{refocus_map}) {	885	if ($input->{refocus_map}) {
835	delete $input->{refocus_map};	886	delete $input->{refocus_map};
836	$MAPWIDGET->focus_in	887	$MAPWIDGET->focus_in
837	}	888	}
838	},	889	},
839	connect_escape => sub {	890	on_escape => sub {
840	$MAPWIDGET->focus_in	891	$MAPWIDGET->focus_in
841	},	892	},
842	);	893	);
843		894
844	$CONSOLE = {	895	$CONSOLE = {
845	window => $window,	896	window => $window,
846	input => $input	897	input => $input,
847	};	898	};
848		899
849	$window	900	$window
850	}	901	}
851		902
852	sub open_quit_dialog {	903	sub open_quit_dialog {
853	unless ($QUIT_DIALOG) {	904	unless ($QUIT_DIALOG) {
854
855	$QUIT_DIALOG = new CFClient::UI::FancyFrame title => "Really Quit?";	905	$QUIT_DIALOG = new CFClient::UI::FancyFrame
		906	x => "center",
		907	y => "center",
		908	z => 50,
		909	title => "Really Quit?",
		910	;
856		911
857	$QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);	912	$QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);
858		913
859	$vb->add (new CFClient::UI::Label	914	$vb->add (new CFClient::UI::Label
860	text => "You should find a savebed and apply it first!",	915	text => "You should find a savebed and apply it first!",
…		…
863	);	918	);
864	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);	919	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
865	$hb->add (new CFClient::UI::Button	920	$hb->add (new CFClient::UI::Button
866	text => "Ok",	921	text => "Ok",
867	expand => 1,	922	expand => 1,
868	connect_activate => sub { $QUIT_DIALOG->hide },	923	on_activate => sub { $QUIT_DIALOG->hide },
869	);	924	);
870	$hb->add (new CFClient::UI::Button	925	$hb->add (new CFClient::UI::Button
871	text => "Quit anyway",	926	text => "Quit anyway",
872	expand => 1,	927	expand => 1,
873	connect_activate => sub { exit },	928	on_activate => sub { exit },
874	);	929	);
		930	}
875		931
876	$QUIT_DIALOG->show_centered;	932	$QUIT_DIALOG->show;
877	} else {	933	}
878	$QUIT_DIALOG->show_centered;	934
		935	sub autopickup_setup {
		936	my $table = new CFClient::UI::Table;
		937
		938	for (
		939	["General", 0, 0,
		940	["Enable autopickup" => CFClient::Pickup::PU_NEWMODE],
		941	["Inhibit autopickup" => CFClient::Pickup::PU_INHIBIT],
		942	["Stop before pickup" => CFClient::Pickup::PU_STOP],
		943	["Debug autopickup" => CFClient::Pickup::PU_DEBUG],
		944	],
		945	["Weapons", 0, 6,
		946	["All weapons" => CFClient::Pickup::PU_ALLWEAPON],
		947	["Missile weapons" => CFClient::Pickup::PU_MISSILEWEAPON],
		948	["Bows" => CFClient::Pickup::PU_BOW],
		949	["Arrows" => CFClient::Pickup::PU_ARROW],
		950	],
		951	["Armour", 0, 12,
		952	["Helmets" => CFClient::Pickup::PU_HELMET],
		953	["Shields" => CFClient::Pickup::PU_SHIELD],
		954	["Body Armour" => CFClient::Pickup::PU_ARMOUR],
		955	["Boots" => CFClient::Pickup::PU_BOOTS],
		956	["Gloves" => CFClient::Pickup::PU_GLOVES],
		957	["Cloaks" => CFClient::Pickup::PU_CLOAK],
		958	],
		959
		960	["Readables", 2, 2,
		961	["Spellbooks" => CFClient::Pickup::PU_SPELLBOOK],
		962	["Skillscrolls" => CFClient::Pickup::PU_SKILLSCROLL],
		963	["Normal Books/Scrolls" => CFClient::Pickup::PU_READABLES],
		964	],
		965	["Misc", 2, 7,
		966	["Food" => CFClient::Pickup::PU_FOOD],
		967	["Drinks" => CFClient::Pickup::PU_DRINK],
		968	["Valuables (Money, Gems)" => CFClient::Pickup::PU_VALUABLES],
		969	["Keys" => CFClient::Pickup::PU_KEY],
		970	["Magical Items" => CFClient::Pickup::PU_MAGICAL],
		971	["Potions" => CFClient::Pickup::PU_POTION],
		972	["Magic Devices" => CFClient::Pickup::PU_MAGIC_DEVICE],
		973	["Ignore cursed" => CFClient::Pickup::PU_NOT_CURSED],
		974	["Jewelery" => CFClient::Pickup::PU_JEWELS],
		975	],
		976	)
879	}	977	{
		978	my ($title, $x, $y, @bits) = @$_;
		979	$table->add ($x, $y, new CFClient::UI::Label text => $title, align => 1, fg => [1, 1, 0]);
		980
		981	for (@bits) {
		982	++$y;
		983
		984	my $mask = $_->[1];
		985	$table->add ($x , $y, new CFClient::UI::Label text => $_->[0], align => 1, expand => 1);
		986	$table->add ($x+1, $y, new CFClient::UI::CheckBox
		987	state => $CFG->{pickup} & $mask,
		988	on_changed => sub {
		989	my ($box, $value) = @_;
		990	if ($value) {
		991	$::CFG->{pickup} |= $mask;
		992	} else {
		993	$::CFG->{pickup} = $::CFG->{pickup} & ~$mask;
		994	}
		995	$::CONN->send (sprintf "command pickup %u", $::CFG->{pickup})
		996	if defined $::CONN;
		997	});
		998	}
		999	}
		1000
		1001	$table
880	}	1002	}
881		1003
882	sub make_inventory_window {	1004	sub make_inventory_window {
883	my $invwin = new CFClient::UI::FancyFrame	1005	my $invwin = $INV_WINDOW = new CFClient::UI::FancyFrame
884	user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Inventory";	1006	x => "center",
		1007	y => "center",
		1008	force_w => $WIDTH * 9/10,
		1009	force_h => $HEIGHT * 9/10,
		1010	title => "Inventory",
		1011	;
885		1012
886	$invwin->add (my $hb = new CFClient::UI::HBox expand => 1);	1013	$invwin->add (my $hb = new CFClient::UI::HBox homogeneous => 1);
887		1014
888	$hb->add (my $vb1 = new CFClient::UI::VBox expand => 1);	1015	$hb->add (my $vb1 = new CFClient::UI::VBox);
889	$vb1->add (my $lbl = new CFClient::UI::Label);	1016	$vb1->add (new CFClient::UI::Label align => 0, text => "Player");
890	$lbl->set_text ("Player");
891	$vb1->add ($INV = new CFClient::UI::Inventory expand => 1);	1017	$vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
892		1018
893	$hb->add (my $vb2 = new CFClient::UI::VBox expand => 1);	1019	$hb->add (my $vb2 = new CFClient::UI::VBox);
		1020
894	$vb2->add ($INVR_LBL = new CFClient::UI::Label);	1021	$vb2->add ($INV_RIGHT_HB = new CFClient::UI::HBox);
895	$INVR_LBL->set_text ("Floor");	1022
896	$vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);	1023	$vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);
897		1024
		1025	# XXX: Call after $INVR = ... because set_opencont sets the items
		1026	CFClient::Protocol::set_opencont ($::CONN, 0, "Floor");
		1027
898	$invwin	1028	$invwin
		1029	}
		1030
		1031	sub spell_setup {
		1032	new CFClient::UI::SpellList
		1033	}
		1034
		1035	sub keyboard_setup {
		1036	my $binding_list = new CFClient::UI::VBox;
		1037
		1038	my $refresh;
		1039	$refresh = sub {
		1040	$binding_list->clear ();
		1041
		1042	for my $mod (keys %{$::CFG->{bindings}}) {
		1043	for my $sym (keys %{$::CFG->{bindings}->{$mod}}) {
		1044	my $cmds = $::CFG->{bindings}->{$mod}->{$sym};
		1045	next unless ref $cmds eq 'ARRAY' and @$cmds > 0;
		1046
		1047	my $lbl = join "; ", @$cmds;
		1048	my $nam = CFClient::Binder::keycombo_to_name ($mod, $sym);
		1049	$binding_list->add (my $hb = new CFClient::UI::HBox);
		1050	$hb->add (new CFClient::UI::Button
		1051	text => "delete",
		1052	tooltip => "Deletes the binding",
		1053	on_activate => sub {
		1054	$binding_list->remove ($hb);
		1055	delete $::CFG->{bindings}->{$mod}->{$sym};
		1056	});
		1057
		1058	$hb->add (new CFClient::UI::Button
		1059	text => "edit",
		1060	tooltip => "Edits the binding",
		1061	on_activate => sub {
		1062	$::BIND_EDITOR->set_binding (
		1063	$mod, $sym, $::CFG->{bindings}->{$mod}->{$sym},
		1064	sub {
		1065	my ($nmod, $nsym, $ncmds) = @_;
		1066	delete $::CFG->{bindings}->{$mod}->{$sym};
		1067	$::CFG->{bindings}->{$nmod}->{$nsym} = $ncmds;
		1068	$refresh->();
		1069	$SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
		1070	$SETUP_DIALOG->show;
		1071	},
		1072	sub {
		1073	$SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
		1074	$SETUP_DIALOG->show;
		1075	});
		1076	$::BIND_EDITOR->show;
		1077	$SETUP_DIALOG->hide;
		1078	});
		1079
		1080	$hb->add (new CFClient::UI::Label text => "(Key: $nam)");
		1081	$hb->add (new CFClient::UI::Label text => $lbl, expand => 1);
		1082	}
		1083	}
		1084	};
		1085
		1086	my $vb = new CFClient::UI::VBox;
		1087	$vb->add ($binding_list);
		1088	$vb->add (my $hb = new CFClient::UI::HBox);
		1089
		1090	$hb->add (new CFClient::UI::Button
		1091	text => "record new",
		1092	expand => 1,
		1093	tooltip => "This button opens the binding editor with an empty binding.",
		1094	on_activate => sub {
		1095	$::BIND_EDITOR->set_binding (undef, undef, [],
		1096	sub {
		1097	my ($mod, $sym, $cmds) = @_;
		1098	$::CFG->{bindings}->{$mod}->{$sym} = $cmds;
		1099	$refresh->();
		1100	$SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
		1101	$SETUP_DIALOG->show;
		1102	},
		1103	sub {
		1104	$SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
		1105	$SETUP_DIALOG->show;
		1106	},
		1107	);
		1108	$SETUP_DIALOG->hide;
		1109	$::BIND_EDITOR->show;
		1110	},
		1111	);
		1112
		1113	$hb->add (new CFClient::UI::Button
		1114	text => "close",
		1115	tooltip => "Closes the binding window",
		1116	expand => 1,
		1117	on_activate => sub {
		1118	$SETUP_DIALOG->hide;
		1119	}
		1120	);
		1121
		1122	$refresh->();
		1123
		1124	$vb
899	}	1125	}
900		1126
901	sub make_help_window {	1127	sub make_help_window {
902	my $win = new CFClient::UI::FancyFrame	1128	my $win = new CFClient::UI::FancyFrame
903	user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Documentation";	1129	x => 'center',
		1130	y => 'center',
		1131	z => 2,
		1132	name => 'doc_browser',
		1133	force_w => int $WIDTH * 7/8,
		1134	force_h => int $HEIGHT * 7/8,
		1135	title => "Documentation";
904		1136
905	$win->add (my $vbox = new CFClient::UI::VBox);	1137	$win->add (my $vbox = new CFClient::UI::VBox);
906		1138
907	$vbox->add (my $buttons = new CFClient::UI::HBox);	1139	$vbox->add (my $buttons = new CFClient::UI::HBox);
908	$vbox->add (my $viewer = new CFClient::UI::TextView expand => 1, fontsize => 0.8);	1140	$vbox->add (my $viewer = new CFClient::UI::TextView expand => 1, fontsize => 0.8);
…		…
915	) {	1147	) {
916	my ($pod, $label) = @$_;	1148	my ($pod, $label) = @$_;
917		1149
918	$buttons->add (new CFClient::UI::Button	1150	$buttons->add (new CFClient::UI::Button
919	text => $label,	1151	text => $label,
920	connect_activate => sub {	1152	on_activate => sub {
921	my $parser = new Pod::POM;	1153	my $pom = CFClient::load_pod CFClient::find_rcfile "pod/$pod.pod",
922	my $pom = $parser->parse_file (CFClient::find_rcfile "pod/$pod.pod");	1154	doc_viewer => 1, sub { CFClient::pod_to_pango_list $_[0] };
923		1155
924	$viewer->clear;	1156	$viewer->clear;
925		1157
926	$viewer->add_paragraph ([1, 1, 1, 1], $_->[1], $_->[0])	1158	$viewer->add_paragraph ([1, 1, 1, 1], $_->[1], $_->[0])
927	for @{ CFClient::pod_to_pango_list $pom };	1159	for @$pom;
928		1160
929	$viewer->set_offset (0);	1161	$viewer->set_offset (0);
930	},	1162	},
931	);	1163	);
932	}	1164	}
…		…
956	or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";	1188	or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";
957		1189
958	$SDL_ACTIVE = 1;	1190	$SDL_ACTIVE = 1;
959	$LAST_REFRESH = time - 0.01;	1191	$LAST_REFRESH = time - 0.01;
960		1192
961	CFClient::gl_init;	1193	CFClient::OpenGL::init;
962		1194
963	$FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};	1195	$FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
964		1196
965	$CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#	1197	$CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
966		1198
…		…
969	if ($DEBUG_STATUS) {	1201	if ($DEBUG_STATUS) {
970	CFClient::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;	1202	CFClient::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
971	} else {	1203	} else {
972	# create the widgets	1204	# create the widgets
973		1205
974	$DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100, req_x => -1;	1206	$DEBUG_STATUS = new CFClient::UI::Label
		1207	padding => 0,
		1208	z => 100,
		1209	force_x => "max",
		1210	force_y => 0;
975	$DEBUG_STATUS->show;	1211	$DEBUG_STATUS->show;
976		1212
		1213	$BIND_EDITOR = new CFClient::UI::BindEditor (x => "max", y => 0);
		1214
977	$STATUSBOX = new CFClient::UI::Statusbox;	1215	$STATUSBOX = new CFClient::UI::Statusbox;
978	$STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", pri => -100, color => [1, 1, 1, 0.8]);	1216	$STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);
979		1217
980	(new CFClient::UI::Frame	1218	(new CFClient::UI::Frame
981	bg => [0, 0, 0, 0.4],	1219	bg => [0, 0, 0, 0.4],
982	req_y => -1,	1220	force_x => 0,
		1221	force_y => "max",
983	child => $STATUSBOX,	1222	child => $STATUSBOX,
984	)->show;	1223	)->show;
985		1224
986	CFClient::UI::FancyFrame->new (	1225	CFClient::UI::FancyFrame->new (
		1226	title => "Map",
		1227	name => "mapmap",
		1228	x => 0,
		1229	y => $FONTSIZE + 8,
987	border_bg => [1, 1, 1, 192/255],	1230	border_bg => [1, 1, 1, 192/255],
988	bg => [1, 1, 1, 0],	1231	bg => [1, 1, 1, 0],
989	child => ($MAPMAP = new CFClient::MapWidget::MapMap	1232	child => ($MAPMAP = new CFClient::MapWidget::MapMap
990	tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",	1233	tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
991	),	1234	),
…		…
1014	can_hover => 1,	1257	can_hover => 1,
1015	can_events => 1,	1258	can_events => 1,
1016	tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",	1259	tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",
1017	;	1260	;
1018		1261
1019	$BUTTONBAR = new CFClient::UI::HBox;	1262	$SETUP_DIALOG = new CFClient::UI::FancyFrame
		1263	title => "Setup",
		1264	name => "setup_dialog",
		1265	x => 'center',
		1266	y => 'center',
		1267	z => 2,
		1268	force_w => $::WIDTH * 0.6,
		1269	force_h => $::HEIGHT * 0.6,
		1270	;
1020		1271
		1272	$SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFClient::UI::Notebook expand => 1, debug => 1,
		1273	filter => new CFClient::UI::ScrolledWindow xxx => 1, expand => 1, scroll_y => 1);
		1274
		1275	$SETUP_NOTEBOOK->add (Server => $SETUP_SERVER = server_setup,
		1276	"Configure the server to play on, your username, password and other server-related options.");
		1277	$SETUP_NOTEBOOK->add (Pickup => autopickup_setup,
		1278	"Configure autopicking stetings, i.e. which items you will pick up automatically when walking over them.");
		1279	$SETUP_NOTEBOOK->add (Graphics => graphics_setup,
		1280	"Configure the video mode, performance, fonts and other graphical aspects of the game.");
		1281	$SETUP_NOTEBOOK->add (Audio => audio_setup,
		1282	"Configure the use of audio, sound effects and background music.");
		1283	$SETUP_NOTEBOOK->add (Keyboard => $SETUP_KEYBOARD = keyboard_setup,
		1284	"Lets you define, edit and delete bindings."
		1285	. "There is a shortcut for making bindings: <b>Left Control + Insert</b> opens the binding editor "
		1286	. "with nothing set and the recording started. After doing the actions you "
		1287	. "want to record press <b>Insert</b> and you will be asked to press a key-combo. "
		1288	. "After pressing the combo the binding will be saved automatically and the "
		1289	. "binding editor closes");
		1290	$SETUP_NOTEBOOK->add (Spells => $SETUP_SPELLS = spell_setup,
		1291	"Displays all spells you have and lets you edit keyboard shortcuts for them.");
		1292
		1293	$BUTTONBAR = new CFClient::UI::Buttonbar x => 0, y => 0, z => 200; # put on top
		1294
1021	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup,	1295	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Setup", other => $SETUP_DIALOG,
1022	tooltip => "Toggles a dialog where you can configure various aspects of the client, such as graphics mode, performance, and audio options.");	1296	tooltip => "Toggles a dialog where you can configure all aspects of this client.");
1023	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup,	1297
1024	tooltip => "Toggles a dialog where you can configure the server to play on, your username, password and other server-related options.");
1025	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window,	1298	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window,
1026	tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");	1299	tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
1027		1300
1028	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	1301	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
1029		1302
1030	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window,	1303	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window,
1031	tooltip => "Toggles the statistics window, where all your Stats and Resistances are being displayed at all times.");	1304	tooltip => "Toggles the statistics window, where all your Stats and Resistances are being displayed at all times.");
1032	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => make_inventory_window,	1305	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => make_inventory_window,
1033	tooltip => "Toggles the inventory window, where you can manage your loot (or treaures :).");	1306	tooltip => "Toggles the inventory window, where you can manage your loot (or treasures :). "
		1307	. "You can also hit the <b>Tab</b>-key to show/hide the Inventory.");
1034		1308
1035	$BUTTONBAR->add (new CFClient::UI::Button	1309	$BUTTONBAR->add (new CFClient::UI::Button
1036	text => "Save Config",	1310	text => "Save Config",
1037	tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",	1311	tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
1038	connect_activate => sub {	1312	on_activate => sub {
		1313	$::CFG->{layout} = CFClient::UI::get_layout;
1039	CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";	1314	CFClient::write_cfg "$Crossfire::VARDIR/cfplusrc";
1040	status "Configuration Saved";	1315	status "Configuration Saved";
1041	},	1316	},
1042	);	1317	);
1043		1318
1044	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => make_help_window,	1319	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => make_help_window,
1045	tooltip => "View Documentation");	1320	tooltip => "View Documentation");
1046		1321
1047	$BUTTONBAR->add (new CFClient::UI::Button	1322	$BUTTONBAR->add (new CFClient::UI::Button
1048	text => "Quit",	1323	text => "Quit",
1049	tooltip => "Terminates the program",	1324	tooltip => "Terminates the program",
1050	connect_activate => sub {	1325	on_activate => sub {
1051	if ($CONN) {	1326	if ($CONN) {
1052	open_quit_dialog;	1327	open_quit_dialog;
1053	} else {	1328	} else {
1054	exit;	1329	exit;
1055	}	1330	}
1056	},	1331	},
1057	);	1332	);
1058		1333
1059	$BUTTONBAR->show;	1334	$BUTTONBAR->show;
		1335	$SETUP_DIALOG->show;
		1336	}
1060		1337
1061	$STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);	1338	$STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
1062
1063	# delay till geometry is constant
1064	$CFClient::UI::ROOT->on_post_alloc (startup => sub {
1065	$BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
1066	my $widget = $GAUGES->{win};
1067	$widget->move (0, $HEIGHT - $widget->{h});#d# to in toplevel
1068	});
1069	force_refresh ();
1070	}
1071	}	1339	}
1072		1340
1073	sub video_shutdown {	1341	sub video_shutdown {
1074	undef $SDL_ACTIVE;	1342	undef $SDL_ACTIVE;
1075	}	1343	}
…		…
1142		1410
1143	my %demo;#d#	1411	my %demo;#d#
1144		1412
1145	sub force_refresh {	1413	sub force_refresh {
1146	$fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;	1414	$fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
1147	debug sprintf "%3.2f", $fps;	1415	debug sprintf "%3.2f", $fps if $ENV{CFPLUS_DEBUG} & 4;
1148		1416
1149	$CFClient::UI::ROOT->draw;	1417	$CFClient::UI::ROOT->draw;
1150		1418
1151	$WANT_REFRESH = 0;	1419	$WANT_REFRESH = 0;
1152	$CAN_REFRESH = 0;	1420	$CAN_REFRESH = 0;
…		…
1207	};	1475	};
1208		1476
1209	CFClient::SDL_GL_SwapBuffers;	1477	CFClient::SDL_GL_SwapBuffers;
1210	}	1478	}
1211		1479
1212	my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {	1480	my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub {
1213	$NOW = time;	1481	$NOW = time;
1214		1482
1215	($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)	1483	($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
1216	for CFClient::SDL_PollEvent;	1484	for CFClient::SDL_PollEvent;
1217		1485
…		…
1235	sub animation_stop {	1503	sub animation_stop {
1236	my ($widget) = @_;	1504	my ($widget) = @_;
1237	delete $animate_object{$widget};	1505	delete $animate_object{$widget};
1238	}	1506	}
1239		1507
1240	@conn::ISA = Crossfire::Protocol::;
1241
1242	sub conn::new {
1243	my $class = shift;
1244
1245	my $self = $class->Crossfire::Protocol::new (@_);
1246
1247	$MAPWIDGET->clr_commands;
1248
1249	my $parser = new Pod::POM;
1250	my $pod = $parser->parse_file (CFClient::find_rcfile "pod/command_help.pod");
1251
1252	for my $head2 ($pod->head2) {
1253	$head2->title =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x
1254	or next;
1255
1256	my $cmd = $1;
1257	my @args = split /\|/, $2;
1258	@args = (".*") unless @args;
1259
1260	my $text = CFClient::pod_to_pango $head2->content;
1261
1262	for my $arg (@args) {
1263	$arg = $arg eq ".*" ? "" : " $arg";
1264
1265	$MAPWIDGET->add_command ("$cmd$arg", $text);
1266	}
1267	}
1268
1269	$self->{noface} = new_from_file CFClient::Texture
1270	CFClient::find_rcfile "noface.png", minify => 1, mipmap => 1;
1271
1272	$self
1273	}
1274
1275	sub conn::stats_update {
1276	my ($self, $stats) = @_;
1277
1278	if (my $exp = $stats->{Crossfire::Protocol::CS_STAT_EXP64}) {
1279	my $diff = $exp - $self->{prev_exp};
1280	$STATUSBOX->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5)
1281	if exists $self->{prev_exp} && $diff;
1282	$self->{prev_exp} = $exp;
1283	}
1284
1285	update_stats_window ($stats);
1286	}
1287
1288	sub conn::user_send {
1289	my ($self, $command) = @_;
1290
1291	$self->send_command ($command);
1292	status $command;
1293	}
1294
1295	sub conn::map_scroll {
1296	my ($self, $dx, $dy) = @_;
1297
1298	$MAP->scroll ($dx, $dy);
1299	}
1300
1301	sub conn::feed_map1a {
1302	my ($self, $data) = @_;
1303
1304	# $self->Crossfire::Protocol::feed_map1a ($data);
1305
1306	$MAP->map1a_update ($data);
1307	$MAPWIDGET->update;
1308	}
1309
1310	sub conn::flush_map {
1311	my ($self) = @_;
1312
1313	my $map_info = delete $self->{map_info}
1314	or return;
1315
1316	my ($hash, $x, $y, $w, $h) = @$map_info;
1317
1318	my $data = $MAP->get_rect ($x, $y, $w, $h);
1319	$MAPCACHE->put ($hash => Compress::LZF::compress $data);
1320	#warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
1321	}
1322
1323	sub conn::map_clear {
1324	my ($self) = @_;
1325
1326	$self->flush_map;
1327	delete $self->{neigh_map};
1328
1329	$MAP->clear;
1330	}
1331
1332
1333	sub conn::load_map($$$) {
1334	my ($self, $hash, $x, $y) = @_;
1335
1336	if (defined (my $data = $MAPCACHE->get ($hash))) {
1337	$data = Compress::LZF::decompress $data;
1338	#warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
1339	for my $id ($MAP->set_rect ($x, $y, $data)) {
1340	my $data = $TILECACHE->get ($id)
1341	or next;
1342
1343	$self->set_texture ($id => $data);
1344	}
1345	}
1346	}
1347
1348	# hardcode /world/world_xxx_xxx map names, the savings are enourmous,
1349	# (server resource,s latency, bandwidth), so this hack is warranted.
1350	# the right fix is to make real tiled maps with an overview file
1351	sub conn::send_mapinfo {
1352	my ($self, $data, $cb) = @_;
1353
1354	if ($self->{map_info}[0] =~ m%^/world/world_(\d\d\d)_(\d\d\d)$%) {
1355	my ($wx, $wy) = ($1, $2);
1356
1357	if ($data =~ /^spatial ([1-4]+)$/) {
1358	my @dx = (0, 0, 1, 0, -1);
1359	my @dy = (0, -1, 0, 1, 0);
1360	my ($dx, $dy);
1361
1362	for (split //, $1) {
1363	$dx += $dx[$_];
1364	$dy += $dy[$_];
1365	}
1366
1367	$cb->(spatial => 15,
1368	$self->{map_info}[1] - $MAP->ox + $dx * 50,
1369	$self->{map_info}[2] - $MAP->oy + $dy * 50,
1370	50, 50,
1371	sprintf "/world/world_%03d_%03d", $wx + $dx, $wy + $dy
1372	);
1373
1374	return;
1375	}
1376	}
1377
1378	$self->Crossfire::Protocol::send_mapinfo ($data, $cb);
1379	}
1380
1381	# this method does a "flood fill" into every tile direction
1382	# it assumes that tiles are arranged in a rectangular grid,
1383	# i.e. a map is the same as the left of the right map etc.
1384	# failure to comply are harmless and result in display errors
1385	# at worst.
1386	sub conn::flood_fill {
1387	my ($self, $block, $gx, $gy, $path, $hash, $flags) = @_;
1388
1389	# the server does not allow map paths > 6
1390	return if 7 <= length $path;
1391
1392	my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
1393
1394	for (
1395	[1, 3, 0, -1],
1396	[2, 4, 1, 0],
1397	[3, 1, 0, 1],
1398	[4, 2, -1, 0],
1399	) {
1400	my ($tile, $tile2, $dx, $dy) = @$_;
1401
1402	next if $block & (1 << $tile);
1403	my $block = $block | (1 << $tile2);
1404
1405	my $gx = $gx + $dx;
1406	my $gy = $gy + $dy;
1407
1408	next unless $flags & (1 << ($tile - 1));
1409	next if $self->{neigh_grid}{$gx, $gy}++;
1410
1411	my $neigh = $self->{neigh_map}{$hash} ||= [];
1412	if (my $info = $neigh->[$tile]) {
1413	my ($flags, $x, $y, $w, $h, $hash) = @$info;
1414
1415	$self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
1416	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1417
1418	} else {
1419	$self->send_mapinfo ("spatial $path$tile", sub {
1420	my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
1421
1422	return if $mode ne "spatial";
1423
1424	$x += $MAP->ox;
1425	$y += $MAP->oy;
1426
1427	$self->load_map ($hash, $x, $y)
1428	unless $self->{neigh_map}{$hash}[5]++;#d#
1429
1430	$neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
1431
1432	$self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
1433	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1434	});
1435	}
1436	}
1437	}
1438
1439	sub conn::map_change {
1440	my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
1441
1442	$self->flush_map;
1443
1444	my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
1445
1446	my $mapmapw = $MAPMAP->{w};
1447	my $mapmaph = $MAPMAP->{h};
1448
1449	$self->{neigh_rect} = [
1450	$ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
1451	$ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
1452	];
1453
1454	delete $self->{neigh_grid};
1455
1456	$x += $ox;
1457	$y += $oy;
1458
1459	$self->{map_info} = [$hash, $x, $y, $w, $h];
1460
1461	(my $map = $hash) =~ s/^.*?\/([^\/]+)$/\1/;
1462	$STATWIDS->{map}->set_text ("Map: " . $map);
1463
1464	$self->load_map ($hash, $x, $y);
1465	$self->flood_fill (0, 0, 0, "", $hash, $flags);
1466	}
1467
1468	sub conn::face_find {
1469	my ($self, $facenum, $face) = @_;
1470
1471	my $hash = "$face->{chksum},$face->{name}";
1472
1473	my $id = $FACEMAP->get ($hash);
1474
1475	unless ($id) {
1476	# create new id for face
1477	# I love transactions
1478	for (1..100) {
1479	my $txn = $CFClient::DB_ENV->txn_begin;
1480	my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);
1481	if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
1482	$id = ($id || 16) + 1;
1483	if ($FACEMAP->put (id => $id) == 0
1484	&& $FACEMAP->put ($hash => $id) == 0) {
1485	$txn->txn_commit;
1486
1487	goto gotid;
1488	}
1489	}
1490	$txn->abort;
1491	}
1492
1493	CFClient::fatal "maximum number of transaction retries reached - database problems?";
1494	}
1495
1496	gotid:
1497	$face->{id} = $id;
1498	$MAP->set_face ($facenum => $id);
1499	$self->{faceid}[$facenum] = $id;#d#
1500
1501	my $face = $TILECACHE->get ($id);
1502
1503	if ($face) {
1504	#$self->face_prefetch;
1505	$face
1506	} else {
1507	my $tex = $self->{noface};
1508	$MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
1509	undef
1510	};
1511	}
1512
1513	sub conn::face_update {
1514	my ($self, $facenum, $face) = @_;
1515
1516	$TILECACHE->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes
1517
1518	$self->set_texture ($face->{id} => delete $face->{image});
1519	}
1520
1521	sub conn::set_texture {
1522	my ($self, $id, $data) = @_;
1523
1524	$self->{texture}[$id] ||= do {
1525	my $tex =
1526	new_from_image CFClient::Texture
1527	$data, minify => 1, mipmap => 1;
1528
1529	$MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
1530	$MAPWIDGET->update;
1531
1532	$tex
1533	};
1534	}
1535
1536	sub conn::sound_play {
1537	my ($self, $x, $y, $soundnum, $type) = @_;
1538
1539	$SDL_MIXER
1540	or return;
1541
1542	my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
1543	or return;
1544
1545	$chunk->play;
1546	# warn "sound $x,$y,$soundnum,$type\n";#d#
1547	}
1548
1549	my $LAST_QUERY; # server is stupid, stupid, stupid
1550
1551	sub conn::query {
1552	my ($self, $flags, $prompt) = @_;
1553
1554	$prompt = $LAST_QUERY unless length $prompt;
1555	$LAST_QUERY = $prompt;
1556
1557	my $dialog = new CFClient::UI::FancyFrame
1558	title => "Query",
1559	child => my $vbox = new CFClient::UI::VBox;
1560
1561	$vbox->add (new CFClient::UI::Label
1562	max_w => $::WIDTH * 0.4,
1563	ellipsise => 0,
1564	text => $prompt);
1565
1566	if ($flags & Crossfire::Protocol::CS_QUERY_YESNO) {
1567	$vbox->add (my $hbox = new CFClient::HBox);
1568	$hbox->add (new CFClient::Button
1569	text => "No",
1570	connect_activate => sub {
1571	$self->send ("reply n");
1572	$dialog->destroy;
1573	$MAPWIDGET->focus_in;
1574	}
1575	);
1576	$hbox->add (new CFClient::Button
1577	text => "Yes",
1578	connect_activate => sub {
1579	$self->send ("reply y");
1580	$dialog->destroy;
1581	},
1582	);
1583
1584	$dialog->focus_in;
1585
1586	} elsif ($flags & Crossfire::Protocol::CS_QUERY_SINGLECHAR) {
1587	$dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";
1588	$vbox->add (my $entry = new CFClient::UI::Entry
1589	connect_changed => sub {
1590	$self->send ("reply $_[1]");
1591	$dialog->destroy;
1592	},
1593	);
1594
1595	$entry->focus_in;
1596
1597	} else {
1598	$dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
1599
1600	$vbox->add (my $entry = new CFClient::UI::Entry
1601	$flags & Crossfire::Protocol::CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (),
1602	connect_activate => sub {
1603	$self->send ("reply $_[1]");
1604	$dialog->destroy;
1605	},
1606	);
1607
1608	$entry->focus_in;
1609	}
1610
1611	$dialog->show_centered;
1612	}
1613
1614	sub conn::drawinfo {
1615	my ($self, $color, $text) = @_;
1616
1617	my @color = (
1618	[1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
1619	[1.00, 1.00, 1.00],
1620	[0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]
1621	[1.00, 0.00, 0.00],
1622	[1.00, 0.54, 0.00],
1623	[0.11, 0.56, 1.00],
1624	[0.93, 0.46, 0.00],
1625	[0.18, 0.54, 0.34],
1626	[0.56, 0.73, 0.56],
1627	[0.80, 0.80, 0.80],
1628	[0.55, 0.41, 0.13],
1629	[0.99, 0.77, 0.26],
1630	[0.74, 0.65, 0.41],
1631	);
1632
1633	my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
1634
1635	$text = CFClient::UI::Label::escape $text;
1636	$text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g;
1637	$text =~ s/\[color=(.*?)\](.*?)\[\/color\]/<span foreground='\1'>\2<\/span>/g;
1638
1639	$LOGVIEW->add_paragraph ($color[$color],
1640	join "\n", map "$time $_", split /\n/, $text);
1641
1642	$STATUSBOX->add ($text,
1643	group => $text,
1644	fg => $color[$color],
1645	timeout => 10,
1646	tooltip_font => $::FONT_FIXED,
1647	);
1648	}
1649
1650	sub conn::drawextinfo {
1651	my ($self, $color, $type, $subtype, $message) = @_;
1652
1653	$self->drawinfo ($color, $message);
1654	}
1655
1656	sub conn::spell_add {
1657	my ($self, $spell) = @_;
1658
1659	# TODO
1660	# create a widget dynamically, using spell face (CF::Protocol downloads them)
1661	$MAPWIDGET->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1662	$MAPWIDGET->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1663	}
1664
1665	sub conn::spell_delete {
1666	my ($self, $spell) = @_;
1667	}
1668
1669	sub conn::addme_success {
1670	my ($self) = @_;
1671
1672	$self->send ("command output-sync $CFG->{output_sync}");
1673	$self->send ("command output-count $CFG->{output_count}");
1674
1675	my $parser = new Pod::POM;
1676	my $pod = $parser->parse_file (CFClient::find_rcfile "pod/skill_help.pod");
1677
1678	my %skill_tooltip;
1679
1680	for my $head2 ($pod->head2) {
1681	$skill_tooltip{$head2->title} = CFClient::pod_to_pango $head2->content;
1682	}
1683
1684	for my $skill (values %{$self->{skill_info}}) {
1685	$MAPWIDGET->add_command ("ready_skill $skill",
1686	(CFClient::UI::Label::escape "Ready the skill '$skill'\n\n")
1687	. $skill_tooltip{$skill});
1688	$MAPWIDGET->add_command ("use_skill $skill",
1689	(CFClient::UI::Label::escape "Immediately use the skill '$skill'\n\n")
1690	. $skill_tooltip{$skill});
1691	}
1692	}
1693
1694	sub conn::eof {
1695	$MAPWIDGET->clr_commands;
1696
1697	stop_game;
1698	}
1699
1700	sub conn::image_info {
1701	my ($self, $numfaces) = @_;
1702
1703	$self->{num_faces} = $numfaces;
1704	$self->{face_prefetch} = [1 .. $numfaces];
1705	$self->face_prefetch;
1706	}
1707
1708	sub conn::face_prefetch {
1709	my ($self) = @_;
1710
1711	return unless $CFG->{face_prefetch};
1712
1713	if ($self->{num_faces}) {
1714	return if @{ $self->{send_queue} || [] };
1715	my $todo = @{ $self->{face_prefetch} }
1716	or return;
1717
1718	my ($face) = splice @{ $self->{face_prefetch} }, + rand @{ $self->{face_prefetch} }, 1, ();
1719
1720	$self->send ("requestinfo image_sums $face $face");
1721
1722	$STATUSBOX->add (CFClient::UI::Label::escape "prefetching $todo",
1723	group => "prefetch", timeout => 2, fg => [1, 1, 0, 0.5]);
1724	} elsif (!exists $self->{num_faces}) {
1725	$self->send ("requestinfo image_info");
1726
1727	$self->{num_faces} = 0;
1728
1729	$STATUSBOX->add (CFClient::UI::Label::escape "starting to prefetch",
1730	group => "prefetch", timeout => 2, fg => [1, 1, 0, 0.5]);
1731	}
1732	}
1733
1734	# check once/second for faces that need to be prefetched	1508	# check once/second for faces that need to be prefetched
1735	# this should, of course, only run on demand, but	1509	# this should, of course, only run on demand, but
1736	# SDL forces worse things on us....	1510	# SDL forces worse things on us....
1737		1511
1738	Event->timer (after => 1, interval => 0.25, cb => sub {	1512	Event->timer (after => 1, interval => 0.25, cb => sub {
1739	$CONN->face_prefetch	1513	$CONN->face_prefetch
1740	if $CONN;	1514	if $CONN;
1741	});	1515	});
1742
1743	sub update_floorbox {
1744	$CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
1745	return unless $CONN;
1746
1747	$FLOORBOX->clear;
1748	$FLOORBOX->add (0, 1, new CFClient::UI::Empty expand => 1);
1749
1750	my $row;
1751	for (@{ $CONN->{container}{0} }) {
1752	if (++$row < 7) {
1753	CFClient::Item::update_widgets $_;
1754	$FLOORBOX->add (0, $row, $_->{face_widget});
1755	$FLOORBOX->add (1, $row, $_->{desc_widget});
1756	} else {
1757	$FLOORBOX->add (new CFClient::UI::Label text => "More...");
1758	last;
1759	}
1760	}
1761	});
1762
1763	$WANT_REFRESH++;
1764	}
1765
1766	sub conn::container_add {
1767	my ($self, $tag, $items) = @_;
1768
1769	#d# print "container_add: container $tag ($self->{player}{tag})\n";
1770
1771	if ($tag == 0) {
1772	update_floorbox;
1773	$OPENCONT = 0;
1774	$INVR_LBL->set_text ("Floor");
1775	$INVR->set_items ($self->{container}{0});
1776	} elsif ($tag == $self->{player}{tag}) {
1777	$INVR_LBL->set_text ("Player");
1778	$INV->set_items ($self->{container}{$self->{player}{tag}})
1779	} else {
1780	$OPENCONT = $tag;
1781	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1782	$INVR->set_items ($self->{container}{$tag});
1783	}
1784
1785	# $self-<{player}{tag} => player inv
1786	#use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1787	}
1788
1789	sub conn::container_clear {
1790	my ($self, $tag) = @_;
1791
1792	#d# print "container_clear: container $tag ($self->{player}{tag})\n";
1793
1794	if ($tag == 0) {
1795	update_floorbox;
1796	$OPENCONT = 0;
1797	$INVR_LBL->set_text ("Floor");
1798	$INVR->set_items ($self->{container}{0});
1799	} elsif ($tag == $self->{player}{tag}) {
1800	$INVR_LBL->set_text ("Player");
1801	$INV->set_items ($self->{container}{$tag})
1802	} else {
1803	$OPENCONT = $tag;
1804	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1805	$INVR->set_items ($self->{container}{$tag});
1806	}
1807
1808	# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1809	}
1810
1811	sub conn::item_delete {
1812	my ($self, @items) = @_;
1813
1814	for (@items) {
1815	#d# print "item_delete: $_->{tag} from $_->{container} ($self->{player}{tag})\n";
1816
1817	if ($_->{container} == 0) {
1818	update_floorbox;
1819	$OPENCONT = 0;
1820	$INVR_LBL->set_text ("Floor");
1821	$INVR->set_items ($self->{container}{0});
1822	} elsif ($_->{container} == $self->{player}{tag}) {
1823	$INVR_LBL->set_text ("Player");
1824	$INV->set_items ($self->{container}{$self->{player}{tag}})
1825	} else {
1826	$OPENCONT = $_->{container};
1827	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1828	$INVR->set_items ($self->{container}{$_->{container}});
1829	}
1830	}
1831	}
1832
1833	sub conn::item_update {
1834	my ($self, $item) = @_;
1835
1836	#d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($OPENCONT)\n";
1837
1838	if ($item->{tag} == $OPENCONT && not ($item->{flags} & Crossfire::Protocol::F_OPEN)) {
1839	$OPENCONT = 0;
1840	$INVR_LBL->set_text ("Floor");
1841	$INVR->set_items ($self->{container}{0});
1842
1843	$item->{widget}->update_item
1844	if $item->{widget};
1845	} else {
1846	if ($item->{container} == 0) {
1847	update_floorbox;
1848	$OPENCONT = 0;
1849	$INVR_LBL->set_text ("Floor");
1850	$INVR->set_items ($self->{container}{0});
1851	} elsif ($item->{container} == $self->{player}{tag}) {
1852	$INV->set_items ($self->{container}{$item->{container}})
1853	}
1854	}
1855	}
1856		1516
1857	%SDL_CB = (	1517	%SDL_CB = (
1858	CFClient::SDL_QUIT => sub {	1518	CFClient::SDL_QUIT => sub {
1859	Event::unloop -1;	1519	Event::unloop -1;
1860	},	1520	},
…		…
1892	#############################################################################	1552	#############################################################################
1893		1553
1894	$SIG{INT} = $SIG{TERM} = sub { exit };	1554	$SIG{INT} = $SIG{TERM} = sub { exit };
1895		1555
1896	{	1556	{
1897	local $SIG{__DIE__} = sub { CFClient::fatal $_[0] };	1557	local $SIG{__DIE__} = sub {
		1558	return unless defined $^S && !$^S;
		1559	Carp::confess $_[1];#d#TODO: remove when stable
		1560	CFClient::fatal $_[0];
		1561	};
1898		1562
1899	CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";	1563	CFClient::read_cfg "$Crossfire::VARDIR/cfplusrc";
1900		1564	CFClient::UI::set_layout ($::CFG->{layout});
1901	$TILECACHE = CFClient::db_table "tilecache";
1902	$FACEMAP = CFClient::db_table "facemap";
1903		1565
1904	my %DEF_CFG = (	1566	my %DEF_CFG = (
1905	sdl_mode => 0,	1567	sdl_mode => 0,
1906	width => 640,	1568	width => 640,
1907	height => 480,	1569	height => 480,
…		…
1984		1646
1985	END { CFClient::SDL_Quit }	1647	END { CFClient::SDL_Quit }
1986		1648
1987	=head1 NAME	1649	=head1 NAME
1988		1650
1989	pclient - A Crossfire+ and Crossfire game client	1651	cfplus - A Crossfire+ and Crossfire game client
1990		1652
1991	=head1 SYNOPSIS	1653	=head1 SYNOPSIS
1992		1654
1993	Just run it - no commandline arguments are supported.	1655	Just run it - no commandline arguments are supported.
1994		1656
1995	=head1 USAGE	1657	=head1 USAGE
1996		1658
1997	Pclient utilises OpenGL for all UI elements and the game. It is supposed to be used	1659	cfplus utilises OpenGL for all UI elements and the game. It is supposed to be used
1998	fullscreen and interactively.	1660	fullscreen and interactively.
1999		1661
		1662	=head1 DEBUGGING
		1663
		1664
		1665	CFPLUS_DEBUG - environment variable
		1666
		1667	1 draw borders around widgets
		1668	2 add low-level widget info to tooltips
		1669	4 show fps
		1670	8 suppress tooltips
		1671
2000	=head1 AUTHOR	1672	=head1 AUTHOR
2001		1673
2002	Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>	1674	Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
2003		1675
2004		1676

Diff Legend

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