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.1 by root, Thu May 25 16:24:45 2006 UTC vs.
Revision 1.51 by root, Sat Jun 3 21:59:55 2006 UTC

…		…
29	use Time::HiRes 'time';	29	use Time::HiRes 'time';
30	use Pod::POM;	30	use Pod::POM;
31	use Event;	31	use Event;
32		32
33	use Crossfire;	33	use Crossfire;
34	use Crossfire::Protocol;	34	use Crossfire::Protocol::Constants;
35		35
36	use Compress::LZF;	36	use Compress::LZF;
37		37
38	use CFClient;	38	use CFClient;
		39	use CFClient::OpenGL ();
		40	use CFClient::Protocol;
39	use CFClient::UI;	41	use CFClient::UI;
40	use CFClient::MapWidget;	42	use CFClient::MapWidget;
41		43
42	$Event::DIED = sub {	44	$Event::DIED = sub {
43	# TODO: display dialog box or so	45	# TODO: display dialog box or so
		46	Carp::confess $_[1];#d#TODO: remove when stable
44	CFClient::error $_[1];	47	CFClient::error $_[1];
45	};	48	};
46		49
47	#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#	50	#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#
48		51
…		…
50		53
51	my $MAX_FPS = 60;	54	my $MAX_FPS = 60;
52	my $MIN_FPS = 5; # unused as of yet	55	my $MIN_FPS = 5; # unused as of yet
53		56
54	our $META_SERVER = "crossfire.real-time.com:13326";	57	our $META_SERVER = "crossfire.real-time.com:13326";
55
56	our $FACEMAP;
57	our $TILECACHE;
58	our $MAPCACHE;
59		58
60	our $LAST_REFRESH;	59	our $LAST_REFRESH;
61	our $NOW;	60	our $NOW;
62		61
63	our $CFG;	62	our $CFG;
…		…
83	our $LOGVIEW;	82	our $LOGVIEW;
84	our $CONSOLE;	83	our $CONSOLE;
85	our $METASERVER;	84	our $METASERVER;
86	our $LOGIN_BUTTON;	85	our $LOGIN_BUTTON;
87	our $QUIT_DIALOG;	86	our $QUIT_DIALOG;
		87	our $HOST_ENTRY;
		88
		89	our $SETUP_DIALOG;
		90	our $SETUP_NOTEBOOK;
		91	our $SETUP_SERVER;
		92	our $SETUP_KEYBOARD;
		93	our $SETUP_SPELLS;
88		94
89	our $FLOORBOX;	95	our $FLOORBOX;
90	our $GAUGES;	96	our $GAUGES;
91	our $STATWIDS;	97	our $STATWIDS;
92		98
…		…
99		105
100	our $ALT_ENTER_MESSAGE;	106	our $ALT_ENTER_MESSAGE;
101	our $STATUSBOX;	107	our $STATUSBOX;
102	our $DEBUG_STATUS;	108	our $DEBUG_STATUS;
103		109
104	our $INVWIN;	110	our $INV_WINDOW;
105	our $INV;	111	our $INV;
106	our $INVR;	112	our $INVR;
107	our $INVR_LBL;	113	our $INV_RIGHT_HB;
108	our $OPENCONT;	114
		115	our $BIND_EDITOR;
		116
		117	our $PICKUP_CFG;
109		118
110	sub status {	119	sub status {
111	$STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);	120	$STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
112	}	121	}
113		122
114	sub debug {	123	sub debug {
115	$DEBUG_STATUS->set_text ($_[0]);	124	$DEBUG_STATUS->set_text ($_[0]);
116	my ($w, $h) = $DEBUG_STATUS->size_request;
117	$DEBUG_STATUS->move ($WIDTH - $w, 0);
118	}	125	}
119		126
120	sub start_game {	127	sub start_game {
121	status "logging in...";	128	status "logging in...";
122		129
		130	$LOGIN_BUTTON->set_text ("Logout");
		131	$SETUP_DIALOG->hide;
		132
123	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;	133	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
124		134
125	$MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";	135	my ($host, $port) = split /:/, $CFG->{host};
		136
126	$MAP = new CFClient::Map $mapsize, $mapsize;	137	$MAP = new CFClient::Map $mapsize, $mapsize;
127
128	my ($host, $port) = split /:/, $CFG->{host};
129		138
130	$CONN = eval {	139	$CONN = eval {
131	new conn	140	new CFClient::Protocol
132	host => $host,	141	host => $host,
133	port => $port || 13327,	142	port => $port || 13327,
134	user => $CFG->{user},	143	user => $CFG->{user},
135	pass => $CFG->{password},	144	pass => $CFG->{password},
136	mapw => $mapsize,	145	mapw => $mapsize,
137	maph => $mapsize,	146	maph => $mapsize,
138	;	147
		148	map_widget => $MAPWIDGET,
		149	logview => $LOGVIEW,
		150	statusbox => $STATUSBOX,
		151	map => $MAP,
		152	mapmap => $MAPMAP,
		153
		154	sound_play => sub {
		155	my ($x, $y, $soundnum, $type) = @_;
		156
		157	$SDL_MIXER
		158	or return;
		159
		160	my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
		161	or return;
		162
		163	$chunk->play;
		164	},
139	};	165	};
140		166
141	if ($CONN) {	167	if ($CONN) {
142	CFClient::lowdelay fileno $CONN->{fh};	168	CFClient::lowdelay fileno $CONN->{fh};
143		169
144	$LOGIN_BUTTON->set_text ("Logout");
145	status "login successful";	170	status "login successful";
146
147	$BUTTONBAR->{children}[1]->emit ("activate")
148	if $BUTTONBAR->{children}[1]->{state};
149
150	} else {	171	} else {
151	status "unable to connect";	172	status "unable to connect";
152	stop_game();	173	stop_game();
153	}	174	}
154	}	175	}
155		176
156	sub stop_game {	177	sub stop_game {
		178	$LOGIN_BUTTON->set_text ("Login");
		179	$SETUP_DIALOG->show;
		180	$INV_WINDOW->hide;
		181	$LOGVIEW->hide;
		182
157	return unless $CONN;	183	return unless $CONN;
158		184
159	status "connection closed";	185	status "connection closed";
160	$LOGIN_BUTTON->set_text ("Login");	186
161	$CONN->destroy;	187	$CONN->destroy;
162	$CONN = 0; # false, does not autovivify	188	$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	}	189	}
170		190
171	sub client_setup {	191	sub graphics_setup {
172	my $dialog = new CFClient::UI::FancyFrame
173	title => "Client Setup",
174	child => (my $vbox = new CFClient::UI::VBox);	192	my $vbox = new CFClient::UI::VBox;
		193
175	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);	194	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
176		195
177	$table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");	196	$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);	197	$table->add (1, 0, my $hbox = new CFClient::UI::HBox);
179		198
180	$hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1]);	199	$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");	200	$hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");
182		201
183	$mode_slider->connect (changed => sub {	202	$mode_slider->connect (changed => sub {
184	my ($self, $value) = @_;	203	my ($self, $value) = @_;
185		204
…		…
192		211
193	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");	212	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
194	$table->add (1, $row++, new CFClient::UI::CheckBox	213	$table->add (1, $row++, new CFClient::UI::CheckBox
195	state => $CFG->{fullscreen},	214	state => $CFG->{fullscreen},
196	tooltip => "Bring the client into fullscreen mode.",	215	tooltip => "Bring the client into fullscreen mode.",
197	connect_changed => sub {	216	on_changed => sub {
198	my ($self, $value) = @_;	217	my ($self, $value) = @_;
199	$CFG->{fullscreen} = $value;	218	$CFG->{fullscreen} = $value;
200	}	219	}
201	);	220	);
202		221
203	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");	222	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
204	$table->add (1, $row++, new CFClient::UI::CheckBox	223	$table->add (1, $row++, new CFClient::UI::CheckBox
205	state => $CFG->{fast},	224	state => $CFG->{fast},
206	tooltip => "Lower the visual quality considerably to speed up rendering.",	225	tooltip => "Lower the visual quality considerably to speed up rendering.",
207	connect_changed => sub {	226	on_changed => sub {
208	my ($self, $value) = @_;	227	my ($self, $value) = @_;
209	$CFG->{fast} = $value;	228	$CFG->{fast} = $value;
210	}	229	}
211	);	230	);
212		231
213	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");	232	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
214	$table->add (1, $row++, new CFClient::UI::Slider	233	$table->add (1, $row++, new CFClient::UI::Slider
215	range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],	234	range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
216	tooltip => "Enlarge or shrink the displayed map. Changes are instant.",	235	tooltip => "Enlarge or shrink the displayed map. Changes are instant.",
217	connect_changed => sub {	236	on_changed => sub {
218	my ($self, $value) = @_;	237	my ($self, $value) = @_;
219	$CFG->{map_scale} = 2 ** $value;	238	$CFG->{map_scale} = 2 ** $value;
220	}	239	}
221	);	240	);
222		241
223	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");	242	$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	243	$table->add (1, $row++, new CFClient::UI::CheckBox
225	state => $CFG->{fow_enable},	244	state => $CFG->{fow_enable},
226	tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",	245	tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",
227	connect_changed => sub {	246	on_changed => sub {
228	my ($self, $value) = @_;	247	my ($self, $value) = @_;
229	$CFG->{fow_enable} = $value;	248	$CFG->{fow_enable} = $value;
230	}	249	}
231	);	250	);
232		251
233	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");	252	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
234	$table->add (1, $row++, new CFClient::UI::Slider	253	$table->add (1, $row++, new CFClient::UI::Slider
235	range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],	254	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.",	255	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 {	256	on_changed => sub {
238	my ($self, $value) = @_;	257	my ($self, $value) = @_;
239	$CFG->{fow_intensity} = $value;	258	$CFG->{fow_intensity} = $value;
240	}	259	}
241	);	260	);
242		261
243	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");	262	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
244	$table->add (1, $row++, new CFClient::UI::CheckBox	263	$table->add (1, $row++, new CFClient::UI::CheckBox
245	state => $CFG->{fow_smooth},	264	state => $CFG->{fow_smooth},
246	tooltip => "Smooth the Fog-of-War a bit to make it more realistic. Changes are instant.",	265	tooltip => "Smooth the Fog-of-War a bit to make it more realistic. Changes are instant.",
247	connect_changed => sub {	266	on_changed => sub {
248	my ($self, $value) = @_;	267	my ($self, $value) = @_;
249	$CFG->{fow_smooth} = $value;	268	$CFG->{fow_smooth} = $value;
250	status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2;	269	status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::OpenGL::GL_VERSION < 1.2;
251	}	270	}
252	);	271	);
253		272
254	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");	273	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
255	$table->add (1, $row++, new CFClient::UI::Slider	274	$table->add (1, $row++, new CFClient::UI::Slider
256	range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],	275	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.",	276	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] },	277	on_changed => sub { $CFG->{gui_fontsize} = $_[1] },
259	);	278	);
260		279
261	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Message Fontsize");	280	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Message Fontsize");
262	$table->add (1, $row++, new CFClient::UI::Slider	281	$table->add (1, $row++, new CFClient::UI::Slider
263	range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],	282	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.",	283	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]) },	284	on_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]) },
266	);	285	);
267		286
268	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");	287	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
269		288
270	$table->add (1, $row++, new CFClient::UI::Slider	289	$table->add (1, $row++, new CFClient::UI::Slider
271	range => [$CFG->{stat_fontsize}, 0.5, 2, 0, 0.1],	290	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.",	291	tooltip => "The font size used by the <b>statistics window</b> only. Changes are instant.",
273	connect_changed => sub {	292	on_changed => sub {
274	$CFG->{stat_fontsize} = $_[1];	293	$CFG->{stat_fontsize} = $_[1];
275	&set_stats_window_fontsize;	294	&set_stats_window_fontsize;
276	}	295	}
277	);	296	);
278		297
279	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");	298	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
280	$table->add (1, $row++, new CFClient::UI::Slider	299	$table->add (1, $row++, new CFClient::UI::Slider
281	range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],	300	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.",	301	tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.",
283	connect_changed => sub {	302	on_changed => sub {
284	$CFG->{gauge_fontsize} = $_[1];	303	$CFG->{gauge_fontsize} = $_[1];
285	&set_gauge_window_fontsize;	304	&set_gauge_window_fontsize;
286	}	305	}
287	);	306	);
288		307
289	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");	308	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
290	$table->add (1, $row++, new CFClient::UI::Slider	309	$table->add (1, $row++, new CFClient::UI::Slider
291	range => [$CFG->{gauge_size}, 0.2, 0.8],	310	range => [$CFG->{gauge_size}, 0.2, 0.8],
292	tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",	311	tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",
293	connect_changed => sub {	312	on_changed => sub {
294	$CFG->{gauge_size} = $_[1];	313	$CFG->{gauge_size} = $_[1];
295	$GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});	314	$GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
296	}	315	}
297	);	316	);
298		317
299	$table->add (1, $row++, new CFClient::UI::Button	318	$table->add (1, $row++, new CFClient::UI::Button
300	expand => 1, align => 0, text => "Apply",	319	expand => 1, align => 0, text => "Apply",
301	tooltip => "Apply the video settings",	320	tooltip => "Apply the video settings",
302	connect_activate => sub {	321	on_activate => sub {
303	video_shutdown ();	322	video_shutdown ();
304	video_init ();	323	video_init ();
305	}	324	}
306	);	325	);
		326
		327	$vbox
		328	}
		329
		330	sub audio_setup {
		331	my $vbox = new CFClient::UI::VBox;
		332
		333	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
		334
		335	my $row = 0;
307		336
308	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");	337	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");
309	$table->add (1, $row++, new CFClient::UI::CheckBox	338	$table->add (1, $row++, new CFClient::UI::CheckBox
310	state => $CFG->{audio_enable},	339	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.",	340	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 {	341	on_changed => sub {
313	$CFG->{audio_enable} = $_[1];	342	$CFG->{audio_enable} = $_[1];
314	}	343	}
315	);	344	);
316	# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume");	345	# $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 {	346	# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], on_changed => sub {
318	# $CFG->{effects_volume} = $_[1];	347	# $CFG->{effects_volume} = $_[1];
319	# });	348	# });
320	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");	349	$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);	350	$table->add (1, $row++, my $hbox = new CFClient::UI::HBox);
322	$hbox->add (new CFClient::UI::CheckBox	351	$hbox->add (new CFClient::UI::CheckBox
323	expand => 1, state => $CFG->{bgm_enable},	352	expand => 1, state => $CFG->{bgm_enable},
324	tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",	353	tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",
325	connect_changed => sub {	354	on_changed => sub {
326	$CFG->{bgm_enable} = $_[1];	355	$CFG->{bgm_enable} = $_[1];
327	}	356	}
328	);	357	);
329	$hbox->add (new CFClient::UI::Slider	358	$hbox->add (new CFClient::UI::Slider
330	expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],	359	expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],
331	tooltip => "The volume of the background music. Changes are instant.",	360	tooltip => "The volume of the background music. Changes are instant.",
332	connect_changed => sub {	361	on_changed => sub {
333	$CFG->{bgm_volume} = $_[1];	362	$CFG->{bgm_volume} = $_[1];
334	CFClient::MixMusic::volume $_[1] * 128;	363	CFClient::MixMusic::volume $_[1] * 128;
335	}	364	}
336	);	365	);
337		366
338	$table->add (1, $row++, new CFClient::UI::Button	367	$table->add (1, $row++, new CFClient::UI::Button
339	expand => 1, align => 0, text => "Apply",	368	expand => 1, align => 0, text => "Apply",
340	tooltip => "Apply the audio settings",	369	tooltip => "Apply the audio settings",
341	connect_activate => sub {	370	on_activate => sub {
342	audio_shutdown ();	371	audio_shutdown ();
343	audio_init ();	372	audio_init ();
344	}	373	}
345	);	374	);
346		375
347	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Chat Command");	376	$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	}	377	}
361		378
362	sub set_stats_window_fontsize {	379	sub set_stats_window_fontsize {
363	for (values %{$STATWIDS}) {	380	for (values %{$STATWIDS}) {
364	$_->set_fontsize ($::CFG->{stat_fontsize});	381	$_->set_fontsize ($::CFG->{stat_fontsize});
…		…
373		390
374	sub make_gauge_window {	391	sub make_gauge_window {
375	my $gh = int $HEIGHT * $CFG->{gauge_size};	392	my $gh = int $HEIGHT * $CFG->{gauge_size};
376		393
377	my $win = new CFClient::UI::Frame (	394	my $win = new CFClient::UI::Frame (
378	req_y => -1,	395	force_x => 0,
		396	force_y => "max",
379	user_w => $WIDTH,	397	force_w => $WIDTH,
380	user_h => $gh,	398	force_h => $gh,
381	);	399	);
382		400
383	$win->add (my $hbox = new CFClient::UI::HBox	401	$win->add (my $hbox = new CFClient::UI::HBox
384	children => [	402	children => [
385	(new CFClient::UI::HBox expand => 1),	403	(new CFClient::UI::HBox expand => 1),
386	(new CFClient::UI::VBox children => [	404	(new CFClient::UI::VBox children => [
387	(new CFClient::UI::Empty expand => 1),	405	(new CFClient::UI::Empty expand => 1),
388	(new CFClient::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new CFClient::UI::VBox)),	406	(new CFClient::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new CFClient::UI::Table)),
389	]),	407	]),
390	(my $vbox = new CFClient::UI::VBox),	408	(my $vbox = new CFClient::UI::VBox),
391	],	409	],
392	);	410	);
393		411
…		…
421	&set_gauge_window_fontsize;	439	&set_gauge_window_fontsize;
422		440
423	$win	441	$win
424	}	442	}
425		443
		444
426	sub make_stats_window {	445	sub make_stats_window {
427	my $tgw = new CFClient::UI::FancyFrame title => "Stats";	446	my $tgw = new CFClient::UI::FancyFrame
		447	y => $HEIGHT * (2/8),
		448	x => "max",
		449	title => "Stats",
		450	name => "stats_window";
428		451
429	$tgw->add (new CFClient::UI::Window child => my $vb = new CFClient::UI::VBox);	452	$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,	453	$vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,
431	can_hover => 1, can_events => 1,	454	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.");	455	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,	456	$vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,
434	can_hover => 1, can_events => 1,	457	can_hover => 1, can_events => 1,
435	tooltip => "The map you are currently on (if supported by the server).");	458	tooltip => "The map you are currently on (if supported by the server).");
		459
		460	$vb->add (my $hb0 = new CFClient::UI::HBox);
		461	$hb0->add ($STATWIDS->{weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1,
		462	can_hover => 1, can_events => 1,
		463	tooltip => "The weight of the player including all inventory items.");
		464	$hb0->add ($STATWIDS->{m_weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1,
		465	can_hover => 1, can_events => 1,
		466	tooltip => "The weight limit: you cannot carry more than this.");
		467
436		468
437	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);	469	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
438	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);	470	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);
439		471
440	my $color2 = [1, 1, 0];	472	my $color2 = [1, 1, 0];
…		…
522	update_stats_window ({});	554	update_stats_window ({});
523		555
524	$tgw	556	$tgw
525	}	557	}
526		558
527	sub formsep {	559	sub formsep($) {
528	reverse join ",", grep length, split /(...)/, reverse $_[0] * 1	560	scalar reverse join ",", unpack "(A3)*", reverse $_[0] * 1
529	}	561	}
530		562
531	sub update_stats_window {	563	sub update_stats_window {
532	my ($stats) = @_;	564	my ($stats) = @_;
533		565
534	# i love text protocols!!!	566	# I love text protocols...
		567
535	my $hp = $stats->{Crossfire::Protocol::CS_STAT_HP} * 1;	568	my $hp = $stats->{+CS_STAT_HP} * 1;
536	my $hp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXHP} * 1;	569	my $hp_m = $stats->{+CS_STAT_MAXHP} * 1;
537	my $sp = $stats->{Crossfire::Protocol::CS_STAT_SP} * 1;	570	my $sp = $stats->{+CS_STAT_SP} * 1;
538	my $sp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXSP} * 1;	571	my $sp_m = $stats->{+CS_STAT_MAXSP} * 1;
539	my $fo = $stats->{Crossfire::Protocol::CS_STAT_FOOD} * 1;	572	my $fo = $stats->{+CS_STAT_FOOD} * 1;
540	my $fo_m = 999;	573	my $fo_m = 999;
541	my $gr = $stats->{Crossfire::Protocol::CS_STAT_GRACE} * 1;	574	my $gr = $stats->{+CS_STAT_GRACE} * 1;
542	my $gr_m = $stats->{Crossfire::Protocol::CS_STAT_MAXGRACE} * 1;	575	my $gr_m = $stats->{+CS_STAT_MAXGRACE} * 1;
543		576
544	$GAUGES->{hp} ->set_value ($hp, $hp_m);	577	$GAUGES->{hp} ->set_value ($hp, $hp_m);
545	$GAUGES->{mana} ->set_value ($sp, $sp_m);	578	$GAUGES->{mana} ->set_value ($sp, $sp_m);
546	$GAUGES->{food} ->set_value ($fo, $fo_m);	579	$GAUGES->{food} ->set_value ($fo, $fo_m);
547	$GAUGES->{grace} ->set_value ($gr, $gr_m);	580	$GAUGES->{grace} ->set_value ($gr, $gr_m);
548	$GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::CS_STAT_EXP64})	581	$GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{+CS_STAT_EXP64})
549	. " (lvl " . ($stats->{Crossfire::Protocol::CS_STAT_LEVEL} * 1) . ")");	582	. " (lvl " . ($stats->{+CS_STAT_LEVEL} * 1) . ")");
550	my $rng = $stats->{Crossfire::Protocol::CS_STAT_RANGE};	583	my $rng = $stats->{+CS_STAT_RANGE};
551	$rng =~ s/^Range: //; # thank you so much dear server	584	$rng =~ s/^Range: //; # thank you so much dear server
552	$GAUGES->{range} ->set_text ("Rng: " . $rng);	585	$GAUGES->{range} ->set_text ("Rng: " . $rng);
553	my $title = $stats->{Crossfire::Protocol::CS_STAT_TITLE};	586	my $title = $stats->{+CS_STAT_TITLE};
554	$title =~ s/^Player: //;	587	$title =~ s/^Player: //;
555	$STATWIDS->{title} ->set_text ("Title: " . $title);	588	$STATWIDS->{title} ->set_text ("Title: " . $title);
556		589
557	$STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});	590	$STATWIDS->{st_str} ->set_text (sprintf "%d" , $stats->{+CS_STAT_STR});
558	$STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});	591	$STATWIDS->{st_dex} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DEX});
559	$STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9});	592	$STATWIDS->{st_con} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CON});
560	$STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6});	593	$STATWIDS->{st_int} ->set_text (sprintf "%d" , $stats->{+CS_STAT_INT});
561	$STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7});	594	$STATWIDS->{st_wis} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WIS});
562	$STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22});	595	$STATWIDS->{st_pow} ->set_text (sprintf "%d" , $stats->{+CS_STAT_POW});
563	$STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});	596	$STATWIDS->{st_cha} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CHA});
564	$STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13});	597	$STATWIDS->{st_wc} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WC});
565	$STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14});	598	$STATWIDS->{st_ac} ->set_text (sprintf "%d" , $stats->{+CS_STAT_AC});
566	$STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});	599	$STATWIDS->{st_dam} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DAM});
567	$STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});	600	$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});	601	$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});	602	$STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{+CS_STAT_WEAP_SP});
570		603
		604	$STATWIDS->{m_weight}->set_text (sprintf "Max weight: %.1fkg", $stats->{+CS_STAT_WEIGHT_LIM} / 1000);
		605
		606	# TODO: replace by CS_STAT_RES_xxx constants
571	my %tbl = (	607	my %tbl = (
572	phys => 100,	608	phys => 100,
573	magic => 101,	609	magic => 101,
574	fire => 102,	610	fire => 102,
575	elec => 103,	611	elec => 103,
…		…
584	tund => 112,	620	tund => 112,
585	fear => 113,	621	fear => 113,
586	depl => 113,	622	depl => 113,
587	deat => 115,	623	deat => 115,
588	holyw => 116,	624	holyw => 116,
589	blind => 117	625	blind => 117,
590	);	626	);
591		627
592	for (keys %tbl) {
593	$STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}});	628	$STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}})
594	}	629	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	}	630	}
607		631
608	my $METASERVER_ATIME;	632	my $METASERVER_ATIME;
609		633
610	sub update_metaserver {	634	sub update_metaserver {
611	my ($HOST) = @_;
612
613	return if $METASERVER_ATIME > time;	635	return if $METASERVER_ATIME > time;
614	$METASERVER_ATIME = time + 60;	636	$METASERVER_ATIME = time + 60;
615		637
616	my $table = $METASERVER->{table};	638	my $table = $METASERVER->{table};
617	$table->clear;	639	$table->clear;
…		…
668	$m = [$users, $host, $uptime, $version, $desc];	690	$m = [$users, $host, $uptime, $version, $desc];
669		691
670	$y++;	692	$y++;
671		693
672	$table->add (0, $y, new CFClient::UI::VBox children => [	694	$table->add (0, $y, new CFClient::UI::VBox children => [
673	(new CFClient::UI::Button text => "Use", connect_activate => sub {	695	(new CFClient::UI::Button text => "Use", on_activate => sub {
674	$HOST->set_text ($CFG->{host} = $host);	696	$HOST_ENTRY->set_text ($CFG->{host} = $host);
		697	$METASERVER->toggle_visibility;
675	}),	698	}),
676	(new CFClient::UI::Empty expand => 1),	699	(new CFClient::UI::Empty expand => 1),
677	]);	700	]);
678		701
679	$table->add ($_ + 1, $y, new CFClient::UI::Label	702	$table->add ($_ + 1, $y, new CFClient::UI::Label
…		…
682	}	705	}
683	}	706	}
684	});	707	});
685	}	708	}
686		709
		710	sub metaserver_dialog {
		711	my $dialog = new CFClient::UI::FancyFrame
		712	title => "Server List",
		713	name => 'metaserver_dialog',
		714	x => 'center',
		715	y => 'center',
		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	title => "Really Quit?",
		909	;
856		910
857	$QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);	911	$QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);
858		912
859	$vb->add (new CFClient::UI::Label	913	$vb->add (new CFClient::UI::Label
860	text => "You should find a savebed and apply it first!",	914	text => "You should find a savebed and apply it first!",
…		…
863	);	917	);
864	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);	918	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
865	$hb->add (new CFClient::UI::Button	919	$hb->add (new CFClient::UI::Button
866	text => "Ok",	920	text => "Ok",
867	expand => 1,	921	expand => 1,
868	connect_activate => sub { $QUIT_DIALOG->hide },	922	on_activate => sub { $QUIT_DIALOG->hide },
869	);	923	);
870	$hb->add (new CFClient::UI::Button	924	$hb->add (new CFClient::UI::Button
871	text => "Quit anyway",	925	text => "Quit anyway",
872	expand => 1,	926	expand => 1,
873	connect_activate => sub { exit },	927	on_activate => sub { exit },
874	);	928	);
		929	}
875		930
876	$QUIT_DIALOG->show_centered;	931	$QUIT_DIALOG->show;
877	} else {	932	}
878	$QUIT_DIALOG->show_centered;	933
		934	sub autopickup_setup {
		935	my $table = new CFClient::UI::Table;
		936
		937	for (
		938	["General", 0, 0,
		939	["Enable autopickup" => CFClient::Pickup::PU_NEWMODE],
		940	["Inhibit autopickup" => CFClient::Pickup::PU_INHIBIT],
		941	["Stop before pickup" => CFClient::Pickup::PU_STOP],
		942	["Debug autopickup" => CFClient::Pickup::PU_DEBUG],
		943	],
		944	["Weapons", 0, 6,
		945	["All weapons" => CFClient::Pickup::PU_ALLWEAPON],
		946	["Missile weapons" => CFClient::Pickup::PU_MISSILEWEAPON],
		947	["Bows" => CFClient::Pickup::PU_BOW],
		948	["Arrows" => CFClient::Pickup::PU_ARROW],
		949	],
		950	["Armour", 0, 12,
		951	["Helmets" => CFClient::Pickup::PU_HELMET],
		952	["Shields" => CFClient::Pickup::PU_SHIELD],
		953	["Body Armour" => CFClient::Pickup::PU_ARMOUR],
		954	["Boots" => CFClient::Pickup::PU_BOOTS],
		955	["Gloves" => CFClient::Pickup::PU_GLOVES],
		956	["Cloaks" => CFClient::Pickup::PU_CLOAK],
		957	],
		958
		959	["Readables", 2, 2,
		960	["Spellbooks" => CFClient::Pickup::PU_SPELLBOOK],
		961	["Skillscrolls" => CFClient::Pickup::PU_SKILLSCROLL],
		962	["Normal Books/Scrolls" => CFClient::Pickup::PU_READABLES],
		963	],
		964	["Misc", 2, 7,
		965	["Food" => CFClient::Pickup::PU_FOOD],
		966	["Drinks" => CFClient::Pickup::PU_DRINK],
		967	["Valuables (Money, Gems)" => CFClient::Pickup::PU_VALUABLES],
		968	["Keys" => CFClient::Pickup::PU_KEY],
		969	["Magical Items" => CFClient::Pickup::PU_MAGICAL],
		970	["Potions" => CFClient::Pickup::PU_POTION],
		971	["Magic Devices" => CFClient::Pickup::PU_MAGIC_DEVICE],
		972	["Ignore cursed" => CFClient::Pickup::PU_NOT_CURSED],
		973	["Jewelery" => CFClient::Pickup::PU_JEWELS],
		974	],
		975	)
879	}	976	{
		977	my ($title, $x, $y, @bits) = @$_;
		978	$table->add ($x, $y, new CFClient::UI::Label text => $title, align => 1, fg => [1, 1, 0]);
		979
		980	for (@bits) {
		981	++$y;
		982
		983	my $mask = $_->[1];
		984	$table->add ($x , $y, new CFClient::UI::Label text => $_->[0], align => 1, expand => 1);
		985	$table->add ($x+1, $y, new CFClient::UI::CheckBox
		986	state => $CFG->{pickup} & $mask,
		987	on_changed => sub {
		988	my ($box, $value) = @_;
		989	if ($value) {
		990	$::CFG->{pickup} |= $mask;
		991	} else {
		992	$::CFG->{pickup} = $::CFG->{pickup} & ~$mask;
		993	}
		994	$::CONN->send (sprintf "command pickup %u", $::CFG->{pickup})
		995	if defined $::CONN;
		996	});
		997	}
		998	}
		999
		1000	$table
880	}	1001	}
881		1002
882	sub make_inventory_window {	1003	sub make_inventory_window {
883	my $invwin = new CFClient::UI::FancyFrame	1004	my $invwin = $INV_WINDOW = new CFClient::UI::FancyFrame
884	user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Inventory";	1005	x => "center",
		1006	y => "center",
		1007	force_w => $WIDTH * 9/10,
		1008	force_h => $HEIGHT * 9/10,
		1009	title => "Inventory",
		1010	;
885		1011
886	$invwin->add (my $hb = new CFClient::UI::HBox expand => 1);	1012	$invwin->add (my $hb = new CFClient::UI::HBox homogeneous => 1);
887		1013
888	$hb->add (my $vb1 = new CFClient::UI::VBox expand => 1);	1014	$hb->add (my $vb1 = new CFClient::UI::VBox);
889	$vb1->add (my $lbl = new CFClient::UI::Label);	1015	$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);	1016	$vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
892		1017
893	$hb->add (my $vb2 = new CFClient::UI::VBox expand => 1);	1018	$hb->add (my $vb2 = new CFClient::UI::VBox);
		1019
894	$vb2->add ($INVR_LBL = new CFClient::UI::Label);	1020	$vb2->add ($INV_RIGHT_HB = new CFClient::UI::HBox);
895	$INVR_LBL->set_text ("Floor");	1021
896	$vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);	1022	$vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);
897		1023
		1024	# XXX: Call after $INVR = ... because set_opencont sets the items
		1025	CFClient::Protocol::set_opencont ($::CONN, 0, "Floor");
		1026
898	$invwin	1027	$invwin
		1028	}
		1029
		1030	sub spell_setup {
		1031	new CFClient::UI::SpellList
		1032	}
		1033
		1034	sub keyboard_setup {
		1035	my $binding_list = new CFClient::UI::VBox;
		1036
		1037	my $refresh;
		1038	$refresh = sub {
		1039	$binding_list->clear ();
		1040
		1041	for my $mod (keys %{$::CFG->{bindings}}) {
		1042	for my $sym (keys %{$::CFG->{bindings}->{$mod}}) {
		1043	my $cmds = $::CFG->{bindings}->{$mod}->{$sym};
		1044	next unless ref $cmds eq 'ARRAY' and @$cmds > 0;
		1045
		1046	my $lbl = join "; ", @$cmds;
		1047	my $nam = CFClient::Binder::keycombo_to_name ($mod, $sym);
		1048	$binding_list->add (my $hb = new CFClient::UI::HBox);
		1049	$hb->add (new CFClient::UI::Button
		1050	text => "delete",
		1051	tooltip => "Deletes the binding",
		1052	on_activate => sub {
		1053	$binding_list->remove ($hb);
		1054	delete $::CFG->{bindings}->{$mod}->{$sym};
		1055	});
		1056
		1057	$hb->add (new CFClient::UI::Button
		1058	text => "edit",
		1059	tooltip => "Edits the binding",
		1060	on_activate => sub {
		1061	$::BIND_EDITOR->set_binding (
		1062	$mod, $sym, $::CFG->{bindings}->{$mod}->{$sym},
		1063	sub {
		1064	my ($nmod, $nsym, $ncmds) = @_;
		1065	delete $::CFG->{bindings}->{$mod}->{$sym};
		1066	$::CFG->{bindings}->{$nmod}->{$nsym} = $ncmds;
		1067	$refresh->();
		1068	$SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
		1069	$SETUP_DIALOG->show;
		1070	},
		1071	sub {
		1072	$SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
		1073	$SETUP_DIALOG->show;
		1074	});
		1075	$::BIND_EDITOR->show;
		1076	$SETUP_DIALOG->hide;
		1077	});
		1078
		1079	$hb->add (new CFClient::UI::Label text => "(Key: $nam)");
		1080	$hb->add (new CFClient::UI::Label text => $lbl, expand => 1);
		1081	}
		1082	}
		1083	};
		1084
		1085	my $vb = new CFClient::UI::VBox;
		1086	$vb->add ($binding_list);
		1087	$vb->add (my $hb = new CFClient::UI::HBox);
		1088
		1089	$hb->add (new CFClient::UI::Button
		1090	text => "record new",
		1091	expand => 1,
		1092	tooltip => "This button opens the binding editor with an empty binding.",
		1093	on_activate => sub {
		1094	$::BIND_EDITOR->set_binding (undef, undef, [],
		1095	sub {
		1096	my ($mod, $sym, $cmds) = @_;
		1097	$::CFG->{bindings}->{$mod}->{$sym} = $cmds;
		1098	$refresh->();
		1099	$SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
		1100	$SETUP_DIALOG->show;
		1101	},
		1102	sub {
		1103	$SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
		1104	$SETUP_DIALOG->show;
		1105	});
		1106	$SETUP_DIALOG->hide;
		1107	$::BIND_EDITOR->show;
		1108	},
		1109	);
		1110
		1111	$hb->add (new CFClient::UI::Button
		1112	text => "close",
		1113	tooltip => "Closes the binding window",
		1114	expand => 1,
		1115	on_activate => sub {
		1116	$SETUP_DIALOG->hide;
		1117	}
		1118	);
		1119
		1120	$refresh->();
		1121
		1122	$vb
899	}	1123	}
900		1124
901	sub make_help_window {	1125	sub make_help_window {
902	my $win = new CFClient::UI::FancyFrame	1126	my $win = new CFClient::UI::FancyFrame
903	user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Documentation";	1127	x => 'center',
		1128	y => 'center',
		1129	name => 'doc_browser',
		1130	force_w => int $WIDTH * 7/8,
		1131	force_h => int $HEIGHT * 7/8,
		1132	title => "Documentation";
904		1133
905	$win->add (my $vbox = new CFClient::UI::VBox);	1134	$win->add (my $vbox = new CFClient::UI::VBox);
906		1135
907	$vbox->add (my $buttons = new CFClient::UI::HBox);	1136	$vbox->add (my $buttons = new CFClient::UI::HBox);
908	$vbox->add (my $viewer = new CFClient::UI::TextView expand => 1, fontsize => 0.8);	1137	$vbox->add (my $viewer = new CFClient::UI::TextView expand => 1, fontsize => 0.8);
…		…
915	) {	1144	) {
916	my ($pod, $label) = @$_;	1145	my ($pod, $label) = @$_;
917		1146
918	$buttons->add (new CFClient::UI::Button	1147	$buttons->add (new CFClient::UI::Button
919	text => $label,	1148	text => $label,
920	connect_activate => sub {	1149	on_activate => sub {
921	my $parser = new Pod::POM;	1150	my $parser = new Pod::POM;
922	my $pom = $parser->parse_file (CFClient::find_rcfile "pod/$pod.pod");	1151	my $pom = $parser->parse_file (CFClient::find_rcfile "pod/$pod.pod");
923		1152
924	$viewer->clear;	1153	$viewer->clear;
925		1154
…		…
956	or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";	1185	or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";
957		1186
958	$SDL_ACTIVE = 1;	1187	$SDL_ACTIVE = 1;
959	$LAST_REFRESH = time - 0.01;	1188	$LAST_REFRESH = time - 0.01;
960		1189
961	CFClient::gl_init;	1190	CFClient::OpenGL::init;
962		1191
963	$FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};	1192	$FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
964		1193
965	$CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#	1194	$CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
966		1195
…		…
969	if ($DEBUG_STATUS) {	1198	if ($DEBUG_STATUS) {
970	CFClient::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;	1199	CFClient::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
971	} else {	1200	} else {
972	# create the widgets	1201	# create the widgets
973		1202
974	$DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100, req_x => -1;	1203	$DEBUG_STATUS = new CFClient::UI::Label
		1204	padding => 0,
		1205	z => 100,
		1206	force_x => "max",
		1207	force_y => 0;
975	$DEBUG_STATUS->show;	1208	$DEBUG_STATUS->show;
976		1209
		1210	$BIND_EDITOR = new CFClient::UI::BindEditor (x => "max", y => 0);
		1211
977	$STATUSBOX = new CFClient::UI::Statusbox;	1212	$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]);	1213	$STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", pri => -100, color => [1, 1, 1, 0.8]);
979		1214
980	(new CFClient::UI::Frame	1215	(new CFClient::UI::Frame
981	bg => [0, 0, 0, 0.4],	1216	bg => [0, 0, 0, 0.4],
982	req_y => -1,	1217	force_x => 0,
		1218	force_y => "max",
983	child => $STATUSBOX,	1219	child => $STATUSBOX,
984	)->show;	1220	)->show;
985		1221
986	CFClient::UI::FancyFrame->new (	1222	CFClient::UI::FancyFrame->new (
		1223	title => "Map",
		1224	name => "mapmap",
		1225	x => 0,
		1226	y => $FONTSIZE + 8,
987	border_bg => [1, 1, 1, 192/255],	1227	border_bg => [1, 1, 1, 192/255],
988	bg => [1, 1, 1, 0],	1228	bg => [1, 1, 1, 0],
989	child => ($MAPMAP = new CFClient::MapWidget::MapMap	1229	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.",	1230	tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
991	),	1231	),
…		…
1014	can_hover => 1,	1254	can_hover => 1,
1015	can_events => 1,	1255	can_events => 1,
1016	tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",	1256	tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",
1017	;	1257	;
1018		1258
		1259	$SETUP_DIALOG = new CFClient::UI::FancyFrame
		1260	title => "Setup",
		1261	name => "setup_dialog",
		1262	x => 'center',
		1263	y => 'center',
		1264	force_w => $::WIDTH * 0.6,
		1265	force_h => $::HEIGHT * 0.6,
		1266	;
		1267
		1268	$SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFClient::UI::Notebook expand => 1, debug => 1,
		1269	filter => new CFClient::UI::ScrolledWindow xxx => 1, expand => 1, scroll_y => 1);
		1270
		1271	$SETUP_NOTEBOOK->add (Server => $SETUP_SERVER = server_setup,
		1272	"Configure the server to play on, your username, password and other server-related options.");
		1273	$SETUP_NOTEBOOK->add (Pickup => autopickup_setup,
		1274	"Configure autopicking stetings, i.e. which items you will pick up automatically when walking over them.");
		1275	$SETUP_NOTEBOOK->add (Graphics => graphics_setup,
		1276	"Configure the video mode, performance, fonts and other graphical aspects of the game.");
		1277	$SETUP_NOTEBOOK->add (Audio => audio_setup,
		1278	"Configure the use of audio, sound effects and background music.");
		1279	$SETUP_NOTEBOOK->add (Keyboard => $SETUP_KEYBOARD = keyboard_setup,
		1280	"Lets you define, edit and delete bindings."
		1281	. "There is a shortcut for making bindings: Left Control + Insert opens the binding editor "
		1282	. "with nothing set and the recording started. After doing the actions you "
		1283	. "want to record press Insert and you will be asked to press a key-combo."
		1284	. "After pressing the combo the binding will be saved automatically and the "
		1285	. "binding editor closes");
		1286	$SETUP_NOTEBOOK->add (Spells => $SETUP_SPELLS = spell_setup,
		1287	"Displays all spells you have and lets you edit keyboard shortcuts for them.");
		1288
1019	$BUTTONBAR = new CFClient::UI::HBox;	1289	$BUTTONBAR = new CFClient::UI::HBox x => 0, y => 0;
1020		1290
1021	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup,	1291	$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.");	1292	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,	1293
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,	1294	$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.");	1295	tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
1027		1296
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	1297	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		1298
1030	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window,	1299	$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.");	1300	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,	1301	$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 :).");	1302	tooltip => "Toggles the inventory window, where you can manage your loot (or treasures :). "
		1303	."You can also hit the <b>Tab</b>-key to show/hide the Inventory.");
1034		1304
1035	$BUTTONBAR->add (new CFClient::UI::Button	1305	$BUTTONBAR->add (new CFClient::UI::Button
1036	text => "Save Config",	1306	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.",	1307	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 {	1308	on_activate => sub {
		1309	$::CFG->{layout} = CFClient::UI::get_layout;
1039	CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";	1310	CFClient::write_cfg "$Crossfire::VARDIR/cfplusrc";
1040	status "Configuration Saved";	1311	status "Configuration Saved";
1041	},	1312	},
1042	);	1313	);
1043		1314
1044	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => make_help_window,	1315	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => make_help_window,
1045	tooltip => "View Documentation");	1316	tooltip => "View Documentation");
1046		1317
1047	$BUTTONBAR->add (new CFClient::UI::Button	1318	$BUTTONBAR->add (new CFClient::UI::Button
1048	text => "Quit",	1319	text => "Quit",
1049	tooltip => "Terminates the program",	1320	tooltip => "Terminates the program",
1050	connect_activate => sub {	1321	on_activate => sub {
1051	if ($CONN) {	1322	if ($CONN) {
1052	open_quit_dialog;	1323	open_quit_dialog;
1053	} else {	1324	} else {
1054	exit;	1325	exit;
1055	}	1326	}
1056	},	1327	},
1057	);	1328	);
1058		1329
1059	$BUTTONBAR->show;	1330	$BUTTONBAR->show;
		1331	$SETUP_DIALOG->show;
		1332	}
1060		1333
1061	$STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);	1334	$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	}	1335	}
1072		1336
1073	sub video_shutdown {	1337	sub video_shutdown {
1074	undef $SDL_ACTIVE;	1338	undef $SDL_ACTIVE;
1075	}	1339	}
…		…
1142		1406
1143	my %demo;#d#	1407	my %demo;#d#
1144		1408
1145	sub force_refresh {	1409	sub force_refresh {
1146	$fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;	1410	$fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
1147	debug sprintf "%3.2f", $fps;	1411	debug sprintf "%3.2f", $fps if $ENV{CFPLUS_DEBUG} & 4;
1148		1412
1149	$CFClient::UI::ROOT->draw;	1413	$CFClient::UI::ROOT->draw;
1150		1414
1151	$WANT_REFRESH = 0;	1415	$WANT_REFRESH = 0;
1152	$CAN_REFRESH = 0;	1416	$CAN_REFRESH = 0;
…		…
1207	};	1471	};
1208		1472
1209	CFClient::SDL_GL_SwapBuffers;	1473	CFClient::SDL_GL_SwapBuffers;
1210	}	1474	}
1211		1475
1212	my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {	1476	my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub {
1213	$NOW = time;	1477	$NOW = time;
1214		1478
1215	($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)	1479	($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
1216	for CFClient::SDL_PollEvent;	1480	for CFClient::SDL_PollEvent;
1217		1481
…		…
1235	sub animation_stop {	1499	sub animation_stop {
1236	my ($widget) = @_;	1500	my ($widget) = @_;
1237	delete $animate_object{$widget};	1501	delete $animate_object{$widget};
1238	}	1502	}
1239		1503
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	1504	# check once/second for faces that need to be prefetched
1735	# this should, of course, only run on demand, but	1505	# this should, of course, only run on demand, but
1736	# SDL forces worse things on us....	1506	# SDL forces worse things on us....
1737		1507
1738	Event->timer (after => 1, interval => 0.25, cb => sub {	1508	Event->timer (after => 1, interval => 0.25, cb => sub {
1739	$CONN->face_prefetch	1509	$CONN->face_prefetch
1740	if $CONN;	1510	if $CONN;
1741	});	1511	});
1742
1743	sub update_floorbox {
1744	$CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
1745	return unless $CONN;
1746
1747	$FLOORBOX->clear;
1748	$FLOORBOX->add (new CFClient::UI::Empty expand => 1);
1749
1750	my $count = 7;
1751	for (@{ $CONN->{container}{0} }) {
1752	if (--$count) {
1753	$FLOORBOX->add (new CFClient::UI::InventoryItem item => $_);
1754	} else {
1755	$FLOORBOX->add (new CFClient::UI::Label text => "More...");
1756	last;
1757	}
1758	}
1759	});
1760
1761	$WANT_REFRESH++;
1762	}
1763
1764	sub conn::container_add {
1765	my ($self, $tag, $items) = @_;
1766
1767	#d# print "container_add: container $tag ($self->{player}{tag})\n";
1768
1769	if ($tag == 0) {
1770	update_floorbox;
1771	$OPENCONT = 0;
1772	$INVR_LBL->set_text ("Floor");
1773	$INVR->set_items ($self->{container}{0});
1774	} elsif ($tag == $self->{player}{tag}) {
1775	$INVR_LBL->set_text ("Player");
1776	$INV->set_items ($self->{container}{$self->{player}{tag}})
1777	} else {
1778	$OPENCONT = $tag;
1779	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1780	$INVR->set_items ($self->{container}{$tag});
1781	}
1782
1783	# $self-<{player}{tag} => player inv
1784	#use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1785	}
1786
1787	sub conn::container_clear {
1788	my ($self, $tag) = @_;
1789
1790	#d# print "container_clear: container $tag ($self->{player}{tag})\n";
1791
1792	if ($tag == 0) {
1793	update_floorbox;
1794	$OPENCONT = 0;
1795	$INVR_LBL->set_text ("Floor");
1796	$INVR->set_items ($self->{container}{0});
1797	} elsif ($tag == $self->{player}{tag}) {
1798	$INVR_LBL->set_text ("Player");
1799	$INV->set_items ($self->{container}{$tag})
1800	} else {
1801	$OPENCONT = $tag;
1802	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1803	$INVR->set_items ($self->{container}{$tag});
1804	}
1805
1806	# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1807	}
1808
1809	sub conn::item_delete {
1810	my ($self, @items) = @_;
1811
1812	for (@items) {
1813	#d# print "item_delete: $_->{tag} from $_->{container} ($self->{player}{tag})\n";
1814
1815	if ($_->{container} == 0) {
1816	update_floorbox;
1817	$OPENCONT = 0;
1818	$INVR_LBL->set_text ("Floor");
1819	$INVR->set_items ($self->{container}{0});
1820	} elsif ($_->{container} == $self->{player}{tag}) {
1821	$INVR_LBL->set_text ("Player");
1822	$INV->set_items ($self->{container}{$self->{player}{tag}})
1823	} else {
1824	$OPENCONT = $_->{container};
1825	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1826	$INVR->set_items ($self->{container}{$_->{container}});
1827	}
1828	}
1829	}
1830
1831	sub conn::item_update {
1832	my ($self, $item) = @_;
1833
1834	#d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($OPENCONT)\n";
1835
1836	if ($item->{tag} == $OPENCONT && not ($item->{flags} & Crossfire::Protocol::F_OPEN)) {
1837	$OPENCONT = 0;
1838	$INVR_LBL->set_text ("Floor");
1839	$INVR->set_items ($self->{container}{0});
1840
1841	$item->{widget}->update_item
1842	if $item->{widget};
1843	} else {
1844	if ($item->{container} == 0) {
1845	update_floorbox;
1846	$OPENCONT = 0;
1847	$INVR_LBL->set_text ("Floor");
1848	$INVR->set_items ($self->{container}{0});
1849	} elsif ($item->{container} == $self->{player}{tag}) {
1850	$INV->set_items ($self->{container}{$item->{container}})
1851	}
1852	}
1853	}
1854		1512
1855	%SDL_CB = (	1513	%SDL_CB = (
1856	CFClient::SDL_QUIT => sub {	1514	CFClient::SDL_QUIT => sub {
1857	Event::unloop -1;	1515	Event::unloop -1;
1858	},	1516	},
…		…
1890	#############################################################################	1548	#############################################################################
1891		1549
1892	$SIG{INT} = $SIG{TERM} = sub { exit };	1550	$SIG{INT} = $SIG{TERM} = sub { exit };
1893		1551
1894	{	1552	{
1895	local $SIG{__DIE__} = sub { CFClient::fatal $_[0] };	1553	local $SIG{__DIE__} = sub {
		1554	return unless defined $^S && !$^S;
		1555	Carp::confess $_[1];#d#TODO: remove when stable
		1556	CFClient::fatal $_[0];
		1557	};
1896		1558
1897	CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";	1559	CFClient::read_cfg "$Crossfire::VARDIR/cfplusrc";
1898		1560	CFClient::UI::set_layout ($::CFG->{layout});
1899	$TILECACHE = CFClient::db_table "tilecache";
1900	$FACEMAP = CFClient::db_table "facemap";
1901		1561
1902	my %DEF_CFG = (	1562	my %DEF_CFG = (
1903	sdl_mode => 0,	1563	sdl_mode => 0,
1904	width => 640,	1564	width => 640,
1905	height => 480,	1565	height => 480,
…		…
1982		1642
1983	END { CFClient::SDL_Quit }	1643	END { CFClient::SDL_Quit }
1984		1644
1985	=head1 NAME	1645	=head1 NAME
1986		1646
1987	pclient - A Crossfire+ and Crossfire game client	1647	cfplus - A Crossfire+ and Crossfire game client
1988		1648
1989	=head1 SYNOPSIS	1649	=head1 SYNOPSIS
1990		1650
1991	Just run it - no commandline arguments are supported.	1651	Just run it - no commandline arguments are supported.
1992		1652
1993	=head1 USAGE	1653	=head1 USAGE
1994		1654
1995	Pclient utilises OpenGL for all UI elements and the game. It is supposed to be used	1655	cfplus utilises OpenGL for all UI elements and the game. It is supposed to be used
1996	fullscreen and interactively.	1656	fullscreen and interactively.
1997		1657
		1658	=head1 DEBUGGING
		1659
		1660
		1661	CFPLUS_DEBUG - environment variable
		1662
		1663	1 draw borders around widgets
		1664	2 add low-level widget info to tooltips
		1665	4 show fps
		1666	8 suppress tooltips
		1667
1998	=head1 AUTHOR	1668	=head1 AUTHOR
1999		1669
2000	Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>	1670	Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
2001		1671
2002		1672

Diff Legend

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