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.10 by root, Fri May 26 18:28:23 2006 UTC vs.
Revision 1.26 by elmex, Mon May 29 20:12:15 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 ();	39	use CFClient::OpenGL ();
		40	use CFClient::Protocol;
40	use CFClient::UI;	41	use CFClient::UI;
41	use CFClient::MapWidget;	42	use CFClient::MapWidget;
42		43
43	$Event::DIED = sub {	44	$Event::DIED = sub {
44	# TODO: display dialog box or so	45	# TODO: display dialog box or so
…		…
51		52
52	my $MAX_FPS = 60;	53	my $MAX_FPS = 60;
53	my $MIN_FPS = 5; # unused as of yet	54	my $MIN_FPS = 5; # unused as of yet
54		55
55	our $META_SERVER = "crossfire.real-time.com:13326";	56	our $META_SERVER = "crossfire.real-time.com:13326";
56
57	our $FACEMAP;
58	our $TILECACHE;
59	our $MAPCACHE;
60		57
61	our $LAST_REFRESH;	58	our $LAST_REFRESH;
62	our $NOW;	59	our $NOW;
63		60
64	our $CFG;	61	our $CFG;
…		…
84	our $LOGVIEW;	81	our $LOGVIEW;
85	our $CONSOLE;	82	our $CONSOLE;
86	our $METASERVER;	83	our $METASERVER;
87	our $LOGIN_BUTTON;	84	our $LOGIN_BUTTON;
88	our $QUIT_DIALOG;	85	our $QUIT_DIALOG;
		86	our $SERVER_SETUP;
89		87
90	our $FLOORBOX;	88	our $FLOORBOX;
91	our $GAUGES;	89	our $GAUGES;
92	our $STATWIDS;	90	our $STATWIDS;
93		91
…		…
100		98
101	our $ALT_ENTER_MESSAGE;	99	our $ALT_ENTER_MESSAGE;
102	our $STATUSBOX;	100	our $STATUSBOX;
103	our $DEBUG_STATUS;	101	our $DEBUG_STATUS;
104		102
105	our $INVWIN;	103	our $INV_WINDOW;
106	our $INV;	104	our $INV;
107	our $INVR;	105	our $INVR;
108	our $INVR_LBL;	106	our $INVR_LBL;
		107
		108	our $BIND_WINDOW;
109		109
110	sub status {	110	sub status {
111	$STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);	111	$STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
112	}	112	}
113		113
…		…
118	}	118	}
119		119
120	sub start_game {	120	sub start_game {
121	status "logging in...";	121	status "logging in...";
122		122
		123	$LOGIN_BUTTON->set_text ("Logout");
		124	$SERVER_SETUP->hide;
		125
123	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;	126	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
124		127
125	$MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";	128	my ($host, $port) = split /:/, $CFG->{host};
		129
126	$MAP = new CFClient::Map $mapsize, $mapsize;	130	$MAP = new CFClient::Map $mapsize, $mapsize;
127
128	my ($host, $port) = split /:/, $CFG->{host};
129		131
130	$CONN = eval {	132	$CONN = eval {
131	new conn	133	new CFClient::Protocol
132	host => $host,	134	host => $host,
133	port => $port || 13327,	135	port => $port || 13327,
134	user => $CFG->{user},	136	user => $CFG->{user},
135	pass => $CFG->{password},	137	pass => $CFG->{password},
136	mapw => $mapsize,	138	mapw => $mapsize,
137	maph => $mapsize,	139	maph => $mapsize,
138	;	140
		141	map_widget => $MAPWIDGET,
		142	logview => $LOGVIEW,
		143	statusbox => $STATUSBOX,
		144	map => $MAP,
		145	mapmap => $MAPMAP,
		146
		147	sound_play => sub {
		148	my ($x, $y, $soundnum, $type) = @_;
		149
		150	$SDL_MIXER
		151	or return;
		152
		153	my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
		154	or return;
		155
		156	$chunk->play;
		157	},
139	};	158	};
140		159
141	if ($CONN) {	160	if ($CONN) {
142	CFClient::lowdelay fileno $CONN->{fh};	161	CFClient::lowdelay fileno $CONN->{fh};
143		162
144	$LOGIN_BUTTON->set_text ("Logout");
145	status "login successful";	163	status "login successful";
146
147	$BUTTONBAR->{children}[1]->emit ("activate")
148	if $BUTTONBAR->{children}[1]->{state};
149
150	} else {	164	} else {
151	status "unable to connect";	165	status "unable to connect";
152	stop_game();	166	stop_game();
153	}	167	}
154	}	168	}
155		169
156	sub stop_game {	170	sub stop_game {
		171	$LOGIN_BUTTON->set_text ("Login");
		172	$SERVER_SETUP->show;
		173	$INV_WINDOW->hide;
		174	$LOGVIEW->hide;
		175
157	return unless $CONN;	176	return unless $CONN;
158		177
159	status "connection closed";	178	status "connection closed";
160	$LOGIN_BUTTON->set_text ("Login");	179
161	$CONN->destroy;	180	$CONN->destroy;
162	$CONN = 0; # false, does not autovivify	181	$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	}	182	}
170		183
171	sub client_setup {	184	sub client_setup {
172	my $dialog = new CFClient::UI::FancyFrame	185	my $dialog = new CFClient::UI::FancyFrame
		186	req_x => 1,
		187	req_y => $HEIGHT * (1/8),
		188	name => "client_setup",
173	title => "Client Setup",	189	title => "Client Setup",
174	child => (my $vbox = new CFClient::UI::VBox);	190	child => (my $vbox = new CFClient::UI::VBox);
175	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);	191	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
176		192
177	$table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");	193	$table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");
…		…
192		208
193	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");	209	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
194	$table->add (1, $row++, new CFClient::UI::CheckBox	210	$table->add (1, $row++, new CFClient::UI::CheckBox
195	state => $CFG->{fullscreen},	211	state => $CFG->{fullscreen},
196	tooltip => "Bring the client into fullscreen mode.",	212	tooltip => "Bring the client into fullscreen mode.",
197	connect_changed => sub {	213	on_changed => sub {
198	my ($self, $value) = @_;	214	my ($self, $value) = @_;
199	$CFG->{fullscreen} = $value;	215	$CFG->{fullscreen} = $value;
200	}	216	}
201	);	217	);
202		218
203	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");	219	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
204	$table->add (1, $row++, new CFClient::UI::CheckBox	220	$table->add (1, $row++, new CFClient::UI::CheckBox
205	state => $CFG->{fast},	221	state => $CFG->{fast},
206	tooltip => "Lower the visual quality considerably to speed up rendering.",	222	tooltip => "Lower the visual quality considerably to speed up rendering.",
207	connect_changed => sub {	223	on_changed => sub {
208	my ($self, $value) = @_;	224	my ($self, $value) = @_;
209	$CFG->{fast} = $value;	225	$CFG->{fast} = $value;
210	}	226	}
211	);	227	);
212		228
213	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");	229	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
214	$table->add (1, $row++, new CFClient::UI::Slider	230	$table->add (1, $row++, new CFClient::UI::Slider
215	range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],	231	range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
216	tooltip => "Enlarge or shrink the displayed map. Changes are instant.",	232	tooltip => "Enlarge or shrink the displayed map. Changes are instant.",
217	connect_changed => sub {	233	on_changed => sub {
218	my ($self, $value) = @_;	234	my ($self, $value) = @_;
219	$CFG->{map_scale} = 2 ** $value;	235	$CFG->{map_scale} = 2 ** $value;
220	}	236	}
221	);	237	);
222		238
223	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");	239	$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	240	$table->add (1, $row++, new CFClient::UI::CheckBox
225	state => $CFG->{fow_enable},	241	state => $CFG->{fow_enable},
226	tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",	242	tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",
227	connect_changed => sub {	243	on_changed => sub {
228	my ($self, $value) = @_;	244	my ($self, $value) = @_;
229	$CFG->{fow_enable} = $value;	245	$CFG->{fow_enable} = $value;
230	}	246	}
231	);	247	);
232		248
233	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");	249	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
234	$table->add (1, $row++, new CFClient::UI::Slider	250	$table->add (1, $row++, new CFClient::UI::Slider
235	range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],	251	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.",	252	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 {	253	on_changed => sub {
238	my ($self, $value) = @_;	254	my ($self, $value) = @_;
239	$CFG->{fow_intensity} = $value;	255	$CFG->{fow_intensity} = $value;
240	}	256	}
241	);	257	);
242		258
243	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");	259	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
244	$table->add (1, $row++, new CFClient::UI::CheckBox	260	$table->add (1, $row++, new CFClient::UI::CheckBox
245	state => $CFG->{fow_smooth},	261	state => $CFG->{fow_smooth},
246	tooltip => "Smooth the Fog-of-War a bit to make it more realistic. Changes are instant.",	262	tooltip => "Smooth the Fog-of-War a bit to make it more realistic. Changes are instant.",
247	connect_changed => sub {	263	on_changed => sub {
248	my ($self, $value) = @_;	264	my ($self, $value) = @_;
249	$CFG->{fow_smooth} = $value;	265	$CFG->{fow_smooth} = $value;
250	status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2;	266	status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::OpenGL::GL_VERSION < 1.2;
251	}	267	}
252	);	268	);
253		269
254	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");	270	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
255	$table->add (1, $row++, new CFClient::UI::Slider	271	$table->add (1, $row++, new CFClient::UI::Slider
256	range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],	272	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.",	273	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] },	274	on_changed => sub { $CFG->{gui_fontsize} = $_[1] },
259	);	275	);
260		276
261	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Message Fontsize");	277	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Message Fontsize");
262	$table->add (1, $row++, new CFClient::UI::Slider	278	$table->add (1, $row++, new CFClient::UI::Slider
263	range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],	279	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.",	280	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]) },	281	on_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]) },
266	);	282	);
267		283
268	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");	284	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
269		285
270	$table->add (1, $row++, new CFClient::UI::Slider	286	$table->add (1, $row++, new CFClient::UI::Slider
271	range => [$CFG->{stat_fontsize}, 0.5, 2, 0, 0.1],	287	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.",	288	tooltip => "The font size used by the <b>statistics window</b> only. Changes are instant.",
273	connect_changed => sub {	289	on_changed => sub {
274	$CFG->{stat_fontsize} = $_[1];	290	$CFG->{stat_fontsize} = $_[1];
275	&set_stats_window_fontsize;	291	&set_stats_window_fontsize;
276	}	292	}
277	);	293	);
278		294
279	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");	295	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
280	$table->add (1, $row++, new CFClient::UI::Slider	296	$table->add (1, $row++, new CFClient::UI::Slider
281	range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],	297	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.",	298	tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.",
283	connect_changed => sub {	299	on_changed => sub {
284	$CFG->{gauge_fontsize} = $_[1];	300	$CFG->{gauge_fontsize} = $_[1];
285	&set_gauge_window_fontsize;	301	&set_gauge_window_fontsize;
286	}	302	}
287	);	303	);
288		304
289	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");	305	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
290	$table->add (1, $row++, new CFClient::UI::Slider	306	$table->add (1, $row++, new CFClient::UI::Slider
291	range => [$CFG->{gauge_size}, 0.2, 0.8],	307	range => [$CFG->{gauge_size}, 0.2, 0.8],
292	tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",	308	tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",
293	connect_changed => sub {	309	on_changed => sub {
294	$CFG->{gauge_size} = $_[1];	310	$CFG->{gauge_size} = $_[1];
295	$GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});	311	$GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
296	}	312	}
297	);	313	);
298		314
299	$table->add (1, $row++, new CFClient::UI::Button	315	$table->add (1, $row++, new CFClient::UI::Button
300	expand => 1, align => 0, text => "Apply",	316	expand => 1, align => 0, text => "Apply",
301	tooltip => "Apply the video settings",	317	tooltip => "Apply the video settings",
302	connect_activate => sub {	318	on_activate => sub {
303	video_shutdown ();	319	video_shutdown ();
304	video_init ();	320	video_init ();
305	}	321	}
306	);	322	);
307		323
308	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");	324	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");
309	$table->add (1, $row++, new CFClient::UI::CheckBox	325	$table->add (1, $row++, new CFClient::UI::CheckBox
310	state => $CFG->{audio_enable},	326	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.",	327	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 {	328	on_changed => sub {
313	$CFG->{audio_enable} = $_[1];	329	$CFG->{audio_enable} = $_[1];
314	}	330	}
315	);	331	);
316	# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume");	332	# $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 {	333	# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], on_changed => sub {
318	# $CFG->{effects_volume} = $_[1];	334	# $CFG->{effects_volume} = $_[1];
319	# });	335	# });
320	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");	336	$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);	337	$table->add (1, $row++, my $hbox = new CFClient::UI::HBox);
322	$hbox->add (new CFClient::UI::CheckBox	338	$hbox->add (new CFClient::UI::CheckBox
323	expand => 1, state => $CFG->{bgm_enable},	339	expand => 1, state => $CFG->{bgm_enable},
324	tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",	340	tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",
325	connect_changed => sub {	341	on_changed => sub {
326	$CFG->{bgm_enable} = $_[1];	342	$CFG->{bgm_enable} = $_[1];
327	}	343	}
328	);	344	);
329	$hbox->add (new CFClient::UI::Slider	345	$hbox->add (new CFClient::UI::Slider
330	expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],	346	expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],
331	tooltip => "The volume of the background music. Changes are instant.",	347	tooltip => "The volume of the background music. Changes are instant.",
332	connect_changed => sub {	348	on_changed => sub {
333	$CFG->{bgm_volume} = $_[1];	349	$CFG->{bgm_volume} = $_[1];
334	CFClient::MixMusic::volume $_[1] * 128;	350	CFClient::MixMusic::volume $_[1] * 128;
335	}	351	}
336	);	352	);
337		353
338	$table->add (1, $row++, new CFClient::UI::Button	354	$table->add (1, $row++, new CFClient::UI::Button
339	expand => 1, align => 0, text => "Apply",	355	expand => 1, align => 0, text => "Apply",
340	tooltip => "Apply the audio settings",	356	tooltip => "Apply the audio settings",
341	connect_activate => sub {	357	on_activate => sub {
342	audio_shutdown ();	358	audio_shutdown ();
343	audio_init ();	359	audio_init ();
344	}	360	}
345	);	361	);
346		362
…		…
348	$table->add (1, $row++, my $saycmd = new CFClient::UI::Entry	364	$table->add (1, $row++, my $saycmd = new CFClient::UI::Entry
349	text => $CFG->{say_command},	365	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. "	366	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. "	367	. "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.",	368	. "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
353	connect_changed => sub {	369	on_changed => sub {
354	my ($self, $value) = @_;	370	my ($self, $value) = @_;
355	$CFG->{say_command} = $value;	371	$CFG->{say_command} = $value;
356	}	372	}
357	);	373	);
358		374
…		…
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 (
		394	req_x => 0,
378	req_y => -1,	395	req_y => -1,
379	user_w => $WIDTH,	396	def_w => $WIDTH,
380	user_h => $gh,	397	def_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	req_y => $HEIGHT * (2/8),
		447	req_x => -1,
		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.");
…		…
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).");
436		458
437	$vb->add (my $hb0 = new CFClient::UI::HBox);	459	$vb->add (my $hb0 = new CFClient::UI::HBox);
438	$hb0->add ($STATWIDS->{weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1,	460	$hb0->add ($STATWIDS->{weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1,
439	can_hover => 1, can_events => 1,	461	can_hover => 1, can_events => 1,
440	tooltip => "This is the amount the Player weights.");	462	tooltip => "The weight of the player including all inventory items.");
441	$hb0->add ($STATWIDS->{m_weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1,	463	$hb0->add ($STATWIDS->{m_weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1,
442	can_hover => 1, can_events => 1,	464	can_hover => 1, can_events => 1,
443	tooltip => "The weight limit, you can't carry more than this.");	465	tooltip => "The weight limit: you cannot carry more than this.");
444		466
445		467
446	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);	468	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
447	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);	469	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);
448		470
…		…
538	}	560	}
539		561
540	sub update_stats_window {	562	sub update_stats_window {
541	my ($stats) = @_;	563	my ($stats) = @_;
542		564
543	# i love text protocols!!!	565	# I love text protocols...
		566
544	my $hp = $stats->{Crossfire::Protocol::CS_STAT_HP} * 1;	567	my $hp = $stats->{+CS_STAT_HP} * 1;
545	my $hp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXHP} * 1;	568	my $hp_m = $stats->{+CS_STAT_MAXHP} * 1;
546	my $sp = $stats->{Crossfire::Protocol::CS_STAT_SP} * 1;	569	my $sp = $stats->{+CS_STAT_SP} * 1;
547	my $sp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXSP} * 1;	570	my $sp_m = $stats->{+CS_STAT_MAXSP} * 1;
548	my $fo = $stats->{Crossfire::Protocol::CS_STAT_FOOD} * 1;	571	my $fo = $stats->{+CS_STAT_FOOD} * 1;
549	my $fo_m = 999;	572	my $fo_m = 999;
550	my $gr = $stats->{Crossfire::Protocol::CS_STAT_GRACE} * 1;	573	my $gr = $stats->{+CS_STAT_GRACE} * 1;
551	my $gr_m = $stats->{Crossfire::Protocol::CS_STAT_MAXGRACE} * 1;	574	my $gr_m = $stats->{+CS_STAT_MAXGRACE} * 1;
552		575
553	$GAUGES->{hp} ->set_value ($hp, $hp_m);	576	$GAUGES->{hp} ->set_value ($hp, $hp_m);
554	$GAUGES->{mana} ->set_value ($sp, $sp_m);	577	$GAUGES->{mana} ->set_value ($sp, $sp_m);
555	$GAUGES->{food} ->set_value ($fo, $fo_m);	578	$GAUGES->{food} ->set_value ($fo, $fo_m);
556	$GAUGES->{grace} ->set_value ($gr, $gr_m);	579	$GAUGES->{grace} ->set_value ($gr, $gr_m);
557	$GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::CS_STAT_EXP64})	580	$GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{+CS_STAT_EXP64})
558	. " (lvl " . ($stats->{Crossfire::Protocol::CS_STAT_LEVEL} * 1) . ")");	581	. " (lvl " . ($stats->{+CS_STAT_LEVEL} * 1) . ")");
559	my $rng = $stats->{Crossfire::Protocol::CS_STAT_RANGE};	582	my $rng = $stats->{+CS_STAT_RANGE};
560	$rng =~ s/^Range: //; # thank you so much dear server	583	$rng =~ s/^Range: //; # thank you so much dear server
561	$GAUGES->{range} ->set_text ("Rng: " . $rng);	584	$GAUGES->{range} ->set_text ("Rng: " . $rng);
562	my $title = $stats->{Crossfire::Protocol::CS_STAT_TITLE};	585	my $title = $stats->{+CS_STAT_TITLE};
563	$title =~ s/^Player: //;	586	$title =~ s/^Player: //;
564	$STATWIDS->{title} ->set_text ("Title: " . $title);	587	$STATWIDS->{title} ->set_text ("Title: " . $title);
565		588
566	$STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});	589	$STATWIDS->{st_str} ->set_text (sprintf "%d" , $stats->{+CS_STAT_STR});
567	$STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});	590	$STATWIDS->{st_dex} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DEX});
568	$STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9});	591	$STATWIDS->{st_con} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CON});
569	$STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6});	592	$STATWIDS->{st_int} ->set_text (sprintf "%d" , $stats->{+CS_STAT_INT});
570	$STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7});	593	$STATWIDS->{st_wis} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WIS});
571	$STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22});	594	$STATWIDS->{st_pow} ->set_text (sprintf "%d" , $stats->{+CS_STAT_POW});
572	$STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});	595	$STATWIDS->{st_cha} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CHA});
573	$STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13});	596	$STATWIDS->{st_wc} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WC});
574	$STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14});	597	$STATWIDS->{st_ac} ->set_text (sprintf "%d" , $stats->{+CS_STAT_AC});
575	$STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});	598	$STATWIDS->{st_dam} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DAM});
576	$STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});	599	$STATWIDS->{st_arm} ->set_text (sprintf "%d" , $stats->{+CS_STAT_ARMOUR});
577	$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});
578	$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});
579		602
580	$STATWIDS->{m_weight}->set_text (sprintf "Max weight: %.1fkg", $stats->{Crossfire::Protocol::CS_STAT_WEIGHT_LIM} / 1000);	603	$STATWIDS->{m_weight}->set_text (sprintf "Max weight: %.1fkg", $stats->{+CS_STAT_WEIGHT_LIM} / 1000);
581		604
		605	# TODO: replace by CS_STAT_RES_xxx constants
582	my %tbl = (	606	my %tbl = (
583	phys => 100,	607	phys => 100,
584	magic => 101,	608	magic => 101,
585	fire => 102,	609	fire => 102,
586	elec => 103,	610	elec => 103,
…		…
595	tund => 112,	619	tund => 112,
596	fear => 113,	620	fear => 113,
597	depl => 113,	621	depl => 113,
598	deat => 115,	622	deat => 115,
599	holyw => 116,	623	holyw => 116,
600	blind => 117	624	blind => 117,
601	);	625	);
602		626
603	for (keys %tbl) {
604	$STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}});	627	$STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}})
605	}	628	for keys %tbl;
606
607	}	629	}
608		630
609	sub metaserver_dialog {	631	sub metaserver_dialog {
610	my $dialog = new CFClient::UI::FancyFrame	632	my $dialog = new CFClient::UI::FancyFrame
611	title => "Server List",	633	title => "Server List",
…		…
679	$m = [$users, $host, $uptime, $version, $desc];	701	$m = [$users, $host, $uptime, $version, $desc];
680		702
681	$y++;	703	$y++;
682		704
683	$table->add (0, $y, new CFClient::UI::VBox children => [	705	$table->add (0, $y, new CFClient::UI::VBox children => [
684	(new CFClient::UI::Button text => "Use", connect_activate => sub {	706	(new CFClient::UI::Button text => "Use", on_activate => sub {
685	$HOST->set_text ($CFG->{host} = $host);	707	$HOST->set_text ($CFG->{host} = $host);
686	}),	708	}),
687	(new CFClient::UI::Empty expand => 1),	709	(new CFClient::UI::Empty expand => 1),
688	]);	710	]);
689		711
…		…
694	}	716	}
695	});	717	});
696	}	718	}
697		719
698	sub server_setup {	720	sub server_setup {
699	my $dialog = new CFClient::UI::FancyFrame	721	my $dialog = $SERVER_SETUP = new CFClient::UI::FancyFrame
		722	x => $WIDTH * (1/3),
		723	y => $HEIGHT * (1/8),
		724	name => "server_setup",
700	title => "Server Setup",	725	title => "Server Setup",
701	child => (my $vbox = new CFClient::UI::VBox);	726	child => (my $vbox = new CFClient::UI::VBox),
		727	on_visibility_change => sub {
		728	my ($self, $visible) = @_;
		729	$self->center if $visible;
		730	},
702		731	;
		732
703	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);	733	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
704	$table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");	734	$table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
705		735
706	{	736	{
707	$table->add (1, 2, my $vbox = new CFClient::UI::VBox);	737	$table->add (1, 2, my $vbox = new CFClient::UI::VBox);
…		…
709	$vbox->add (	739	$vbox->add (
710	my $HOST = new CFClient::UI::Entry	740	my $HOST = new CFClient::UI::Entry
711	expand => 1,	741	expand => 1,
712	text => $CFG->{host},	742	text => $CFG->{host},
713	tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",	743	tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
714	connect_changed => sub {	744	on_changed => sub {
715	my ($self, $value) = @_;	745	my ($self, $value) = @_;
716	$CFG->{host} = $value;	746	$CFG->{host} = $value;
717	}	747	}
718	);	748	);
719		749
…		…
722	$vbox->add (new CFClient::UI::Flopper	752	$vbox->add (new CFClient::UI::Flopper
723	expand => 1,	753	expand => 1,
724	text => "Server List",	754	text => "Server List",
725	other => $METASERVER,	755	other => $METASERVER,
726	tooltip => "Show a list of available crossfire servers",	756	tooltip => "Show a list of available crossfire servers",
727	connect_open => sub {	757	on_open => sub {
728	update_metaserver $HOST;	758	update_metaserver $HOST;
729	}	759	}
730	);	760	);
731	}	761	}
732		762
733	$table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");	763	$table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
734	$table->add (1, 4, new CFClient::UI::Entry	764	$table->add (1, 4, new CFClient::UI::Entry
735	text => $CFG->{user},	765	text => $CFG->{user},
736	tooltip => "The name of your character on the server",	766	tooltip => "The name of your character on the server",
737	connect_changed => sub {	767	on_changed => sub {
738	my ($self, $value) = @_;	768	my ($self, $value) = @_;
739	$CFG->{user} = $value;	769	$CFG->{user} = $value;
740	}	770	}
741	);	771	);
742		772
743	$table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");	773	$table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
744	$table->add (1, 5, new CFClient::UI::Entry	774	$table->add (1, 5, new CFClient::UI::Entry
745	text => $CFG->{password},	775	text => $CFG->{password},
746	hidden => 1,	776	hidden => 1,
747	tooltip => "The password for your character",	777	tooltip => "The password for your character",
748	connect_changed => sub {	778	on_changed => sub {
749	my ($self, $value) = @_;	779	my ($self, $value) = @_;
750	$CFG->{password} = $value;	780	$CFG->{password} = $value;
751	}	781	}
752	);	782	);
753		783
…		…
757	range => [$CFG->{mapsize}, 10, 100, 0, 1],	787	range => [$CFG->{mapsize}, 10, 100, 0, 1],
758	tooltip => "This is the size of the portion of the map update the server sends you. "	788	tooltip => "This is the size of the portion of the map update the server sends you. "
759	. "If you set this to a high value you will be able to see further, "	789	. "If you set this to a high value you will be able to see further, "
760	. "but you also increase bandwidth requirements and latency. "	790	. "but you also increase bandwidth requirements and latency. "
761	. "This option is only used once at log-in.",	791	. "This option is only used once at log-in.",
762	connect_changed => sub {	792	on_changed => sub {
763	my ($self, $value) = @_;	793	my ($self, $value) = @_;
764		794
765	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;	795	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;
766	},	796	},
767	);	797	);
…		…
774	. "This might increase or create lag, but increases the chances "	804	. "This might increase or create lag, but increases the chances "
775	. "of faces being ready for display when you encounter them. "	805	. "of faces being ready for display when you encounter them. "
776	. "It also uses up server bandwidth on every connect, "	806	. "It also uses up server bandwidth on every connect, "
777	. "so only set it if you really need to prefetch images. "	807	. "so only set it if you really need to prefetch images. "
778	. "This option can be set and unset any time.",	808	. "This option can be set and unset any time.",
779	connect_changed => sub { $CFG->{face_prefetch} = $_[1] },	809	on_changed => sub { $CFG->{face_prefetch} = $_[1] },
780	);	810	);
781		811
782	$table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");	812	$table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");
783	$table->add (1, 9, new CFClient::UI::Entry	813	$table->add (1, 9, new CFClient::UI::Entry
784	text => $CFG->{output_count},	814	text => $CFG->{output_count},
785	tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",	815	tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
786	connect_changed => sub { $CFG->{output_count} = $_[1] },	816	on_changed => sub { $CFG->{output_count} = $_[1] },
787	);	817	);
788		818
789	$table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");	819	$table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");
790	$table->add (1, 10, new CFClient::UI::Entry	820	$table->add (1, 10, new CFClient::UI::Entry
791	text => $CFG->{output_sync},	821	text => $CFG->{output_sync},
792	tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",	822	tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
793	connect_changed => sub { $CFG->{output_sync} = $_[1] },	823	on_changed => sub { $CFG->{output_sync} = $_[1] },
794	);	824	);
795		825
796	$table->add (1, 11, $LOGIN_BUTTON = new CFClient::UI::Button	826	$table->add (1, 11, $LOGIN_BUTTON = new CFClient::UI::Button
797	expand => 1,	827	expand => 1,
798	align => 0,	828	align => 0,
799	text => "Login",	829	text => "Login",
800	connect_activate => sub {	830	on_activate => sub {
801	$CONN ? stop_game	831	$CONN ? stop_game
802	: start_game;	832	: start_game;
803	},	833	},
804	);	834	);
805		835
806	$dialog	836	$dialog
807	}	837	}
808		838
809	sub message_window {	839	sub message_window {
810	my $window = new CFClient::UI::FancyFrame	840	my $window = new CFClient::UI::FancyFrame
		841	name => "message_window",
811	title => "Messages",	842	title => "Messages",
812	border_bg => [1, 1, 1, 1],	843	border_bg => [1, 1, 1, 1],
813	bg => [0, 0, 0, 0.75],	844	bg => [0, 0, 0, 0.75],
		845	req_x => -1,
		846	req_y => 0,
814	user_w => int $::WIDTH / 3,	847	def_w => int $::WIDTH / 3,
815	user_h => int $::HEIGHT / 5,	848	def_h => int $::HEIGHT / 5,
816	child => (my $vbox = new CFClient::UI::VBox);	849	child => (my $vbox = new CFClient::UI::VBox);
817		850
818	$vbox->add ($LOGVIEW);	851	$vbox->add ($LOGVIEW);
819		852
820	$vbox->add (my $input = new CFClient::UI::Entry	853	$vbox->add (my $input = new CFClient::UI::Entry
821	tooltip => "<b>Chat Box</b>. If you enter a text and press return/enter here, the current <i>communication command</i> "	854	tooltip => "<b>Chat Box</b>. If you enter a text and press return/enter here, the current <i>communication command</i> "
822	. "from the client setup will be prepended (e.g. <b>shout</b>, <b>chat</b>...). "	855	. "from the client setup will be prepended (e.g. <b>shout</b>, <b>chat</b>...). "
823	. "If you prepend a slash (/), you will submit a command instead (similar to IRC). "	856	. "If you prepend a slash (/), you will submit a command instead (similar to IRC). "
824	. "A better way to submit commands (and the occasional chat command) is often the map command completer.",	857	. "A better way to submit commands (and the occasional chat command) is often the map command completer.",
825	connect_focus_in => sub {	858	on_focus_in => sub {
826	my ($input, $prev_focus) = @_;	859	my ($input, $prev_focus) = @_;
827		860
828	delete $input->{refocus_map};	861	delete $input->{refocus_map};
829		862
830	if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {	863	if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
831	$input->{refocus_map} = 1;	864	$input->{refocus_map} = 1;
832	}	865	}
833	delete $input->{auto_activated};	866	delete $input->{auto_activated};
834	},	867	},
835	connect_activate => sub {	868	on_activate => sub {
836	my ($input, $text) = @_;	869	my ($input, $text) = @_;
837	$input->set_text ('');	870	$input->set_text ('');
838		871
		872	if ($text =~ /^\/bind\s+(.*)$/) {
		873	CFClient::Recorder::open_binding_dialog ([$1]);
839	if ($text =~ /^\/(.*)/) {	874	} elsif ($text =~ /^\/(.*)/) {
840	$::CONN->user_send ($1);	875	$::CONN->user_send ($1);
841	} else {	876	} else {
842	my $say_cmd = $::CFG->{say_command} || 'say';	877	my $say_cmd = $::CFG->{say_command} || 'say';
843	$::CONN->user_send ("$say_cmd $text");	878	$::CONN->user_send ("$say_cmd $text");
844	}	879	}
845	if ($input->{refocus_map}) {	880	if ($input->{refocus_map}) {
846	delete $input->{refocus_map};	881	delete $input->{refocus_map};
847	$MAPWIDGET->focus_in	882	$MAPWIDGET->focus_in
848	}	883	}
849	},	884	},
850	connect_escape => sub {	885	on_escape => sub {
851	$MAPWIDGET->focus_in	886	$MAPWIDGET->focus_in
852	},	887	},
853	);	888	);
854		889
855	$CONSOLE = {	890	$CONSOLE = {
…		…
860	$window	895	$window
861	}	896	}
862		897
863	sub open_quit_dialog {	898	sub open_quit_dialog {
864	unless ($QUIT_DIALOG) {	899	unless ($QUIT_DIALOG) {
865
866	$QUIT_DIALOG = new CFClient::UI::FancyFrame title => "Really Quit?";	900	$QUIT_DIALOG = new CFClient::UI::FancyFrame title => "Really Quit?";
867		901
868	$QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);	902	$QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);
869		903
870	$vb->add (new CFClient::UI::Label	904	$vb->add (new CFClient::UI::Label
…		…
874	);	908	);
875	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);	909	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
876	$hb->add (new CFClient::UI::Button	910	$hb->add (new CFClient::UI::Button
877	text => "Ok",	911	text => "Ok",
878	expand => 1,	912	expand => 1,
879	connect_activate => sub { $QUIT_DIALOG->hide },	913	on_activate => sub { $QUIT_DIALOG->hide },
880	);	914	);
881	$hb->add (new CFClient::UI::Button	915	$hb->add (new CFClient::UI::Button
882	text => "Quit anyway",	916	text => "Quit anyway",
883	expand => 1,	917	expand => 1,
884	connect_activate => sub { exit },	918	on_activate => sub { exit },
885	);	919	);
		920	}
886		921
		922	$QUIT_DIALOG->show;
887	$QUIT_DIALOG->show_centered;	923	$QUIT_DIALOG->center;
888	} else {
889	$QUIT_DIALOG->show_centered;
890	}
891	}	924	}
892		925
893	sub make_inventory_window {	926	sub make_inventory_window {
894	my $invwin = new CFClient::UI::FancyFrame	927	my $invwin = $INV_WINDOW = new CFClient::UI::FancyFrame
895	user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Inventory";	928	def_w => $WIDTH * 7/8,
		929	def_h => $HEIGHT * 7/8,
		930	title => "Inventory",
		931	name => "inventory_window",
		932	on_visibility_change => sub {
		933	my ($self, $visible) = @_;
		934	$self->center if $visible;
		935	},
		936	;
896		937
897	$invwin->add (my $hb = new CFClient::UI::HBox expand => 1);	938	$invwin->add (my $hb = new CFClient::UI::HBox homogeneous => 1);
898		939
899	$hb->add (my $vb1 = new CFClient::UI::VBox expand => 1);	940	$hb->add (my $vb1 = new CFClient::UI::VBox);
900	$vb1->add (my $lbl = new CFClient::UI::Label xalign => 0.5);	941	$vb1->add (new CFClient::UI::Label align => 0, text => "Player");
901	$lbl->set_text ("Player");
902	$vb1->add ($INV = new CFClient::UI::Inventory expand => 1);	942	$vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
903		943
904	$hb->add (my $vb2 = new CFClient::UI::VBox expand => 1);	944	$hb->add (my $vb2 = new CFClient::UI::VBox);
		945
		946	$vb2->add (my $hb2 = new CFClient::UI::HBox);
905	$vb2->add ($INVR_LBL = new CFClient::UI::Label xalign => 0.5);	947	$hb2->add ($INVR_LBL = new CFClient::UI::Label align => 0, expand => 1, text => "Floor");
906	$INVR_LBL->set_text ("Floor");	948	$hb2->add (new CFClient::UI::Button
		949	text => "Close container",
		950	tooltip => "Close the currently open container (if one is open)",
		951	on_activate => sub {
		952	$CONN->send ("apply $CONN->{open_container}")
		953	if $CONN->{open_container} != 0;
		954	},
		955	);
		956
907	$vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);	957	$vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);
908		958
909	$invwin	959	$invwin
		960	}
		961
		962	sub make_binding_window {
		963	my $binding_list = new CFClient::UI::VBox;
		964
		965	my $refresh = sub {
		966	$binding_list->clear ();
		967
		968	for my $mod (keys %{$::CFG->{bindings}}) {
		969	for my $sym (keys %{$::CFG->{bindings}->{$mod}}) {
		970	my $cmds = $::CFG->{bindings}->{$mod}->{$sym};
		971	next unless ref $cmds eq 'ARRAY' and @$cmds > 0;
		972
		973	my $lbl = join "; ", @$cmds;
		974	my $nam = CFClient::Recorder::keycombo_to_name ($mod, $sym);
		975	$binding_list->add (my $hb = new CFClient::UI::HBox);
		976	$hb->add (new CFClient::UI::Button
		977	text => "delete",
		978	on_activate => sub {
		979	$binding_list->remove ($hb);
		980	delete $::CFG->{bindings}->{$mod}->{$sym};
		981	});
		982	$hb->add (new CFClient::UI::Label text => "($nam)");
		983	$hb->add (new CFClient::UI::Label text => $lbl, expand => 1);
		984	}
		985	}
		986	};
		987
		988	$BIND_WINDOW = new CFClient::UI::FancyFrame
		989	title => "Bindings",
		990	def_w => int $WIDTH * 7/8,
		991	def_h => int $HEIGHT * 7/8,
		992	on_visibility_change => sub {
		993	my ($self, $visible) = @_;
		994	if ($visible) {
		995	$self->center;
		996	$refresh->()
		997	}
		998	};
		999
		1000	$BIND_WINDOW->add ($binding_list);
		1001	$refresh->();
		1002	$BIND_WINDOW
910	}	1003	}
911		1004
912	sub make_help_window {	1005	sub make_help_window {
913	my $win = new CFClient::UI::FancyFrame	1006	my $win = new CFClient::UI::FancyFrame
914	user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Documentation";	1007	def_w => int $WIDTH * 7/8,
		1008	def_h => int $HEIGHT * 7/8,
		1009	title => "Documentation";
915		1010
916	$win->add (my $vbox = new CFClient::UI::VBox);	1011	$win->add (my $vbox = new CFClient::UI::VBox);
917		1012
918	$vbox->add (my $buttons = new CFClient::UI::HBox);	1013	$vbox->add (my $buttons = new CFClient::UI::HBox);
919	$vbox->add (my $viewer = new CFClient::UI::TextView expand => 1, fontsize => 0.8);	1014	$vbox->add (my $viewer = new CFClient::UI::TextView expand => 1, fontsize => 0.8);
…		…
926	) {	1021	) {
927	my ($pod, $label) = @$_;	1022	my ($pod, $label) = @$_;
928		1023
929	$buttons->add (new CFClient::UI::Button	1024	$buttons->add (new CFClient::UI::Button
930	text => $label,	1025	text => $label,
931	connect_activate => sub {	1026	on_activate => sub {
932	my $parser = new Pod::POM;	1027	my $parser = new Pod::POM;
933	my $pom = $parser->parse_file (CFClient::find_rcfile "pod/$pod.pod");	1028	my $pom = $parser->parse_file (CFClient::find_rcfile "pod/$pod.pod");
934		1029
935	$viewer->clear;	1030	$viewer->clear;
936		1031
…		…
1044	tooltip => "Toggles the inventory window, where you can manage your loot (or treaures :).");	1139	tooltip => "Toggles the inventory window, where you can manage your loot (or treaures :).");
1045		1140
1046	$BUTTONBAR->add (new CFClient::UI::Button	1141	$BUTTONBAR->add (new CFClient::UI::Button
1047	text => "Save Config",	1142	text => "Save Config",
1048	tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",	1143	tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
1049	connect_activate => sub {	1144	on_activate => sub {
		1145	$::CFG->{layout} = CFClient::UI::get_layout;
1050	CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";	1146	CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
1051	status "Configuration Saved";	1147	status "Configuration Saved";
1052	},	1148	},
1053	);	1149	);
1054		1150
1055	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => make_help_window,	1151	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => make_help_window,
1056	tooltip => "View Documentation");	1152	tooltip => "View Documentation");
1057		1153
		1154	$BUTTONBAR->add (new CFClient::UI::Flopper
		1155	text => "Bindings",
		1156	other => make_binding_window,
		1157	tooltip => "Lets you delete bindings you have made with the recorder"
		1158	);
		1159	$BUTTONBAR->add (new CFClient::UI::Flopper text => "[Rec]", other => CFClient::Recorder::make_window,
		1160	tooltip => "This feature lets you record a series of actions (eg. walking a path or ready a skill) and bind them to keys");
		1161
1058	$BUTTONBAR->add (new CFClient::UI::Button	1162	$BUTTONBAR->add (new CFClient::UI::Button
1059	text => "Quit",	1163	text => "Quit",
1060	tooltip => "Terminates the program",	1164	tooltip => "Terminates the program",
1061	connect_activate => sub {	1165	on_activate => sub {
1062	if ($CONN) {	1166	if ($CONN) {
1063	open_quit_dialog;	1167	open_quit_dialog;
1064	} else {	1168	} else {
1065	exit;	1169	exit;
1066	}	1170	}
…		…
1069		1173
1070	$BUTTONBAR->show;	1174	$BUTTONBAR->show;
1071		1175
1072	$STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);	1176	$STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
1073		1177
1074	# delay till geometry is constant	1178	$SERVER_SETUP->show;
1075	$CFClient::UI::ROOT->on_post_alloc (startup => sub {
1076	$BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
1077	my $widget = $GAUGES->{win};
1078	$widget->move (0, $HEIGHT - $widget->{h});#d# to in toplevel
1079	});
1080	force_refresh ();
1081	}	1179	}
1082	}	1180	}
1083		1181
1084	sub video_shutdown {	1182	sub video_shutdown {
1085	undef $SDL_ACTIVE;	1183	undef $SDL_ACTIVE;
…		…
1246	sub animation_stop {	1344	sub animation_stop {
1247	my ($widget) = @_;	1345	my ($widget) = @_;
1248	delete $animate_object{$widget};	1346	delete $animate_object{$widget};
1249	}	1347	}
1250		1348
1251	@conn::ISA = Crossfire::Protocol::;
1252
1253	sub conn::new {
1254	my $class = shift;
1255
1256	my $self = $class->Crossfire::Protocol::new (@_);
1257
1258	$MAPWIDGET->clr_commands;
1259
1260	my $parser = new Pod::POM;
1261	my $pod = $parser->parse_file (CFClient::find_rcfile "pod/command_help.pod");
1262
1263	for my $head2 ($pod->head1->[-2]->head2) {
1264	$head2->title =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x
1265	or next;
1266
1267	my $cmd = $1;
1268	my @args = split /\|/, $2;
1269	@args = (".*") unless @args;
1270
1271	my $text = CFClient::pod_to_pango $head2->content;
1272
1273	for my $arg (@args) {
1274	$arg = $arg eq ".*" ? "" : " $arg";
1275
1276	$MAPWIDGET->add_command ("$cmd$arg", $text);
1277	}
1278	}
1279
1280	$self->{noface} = new_from_file CFClient::Texture
1281	CFClient::find_rcfile "noface.png", minify => 1, mipmap => 1;
1282
1283	$self->{open_container} = 0;
1284
1285	$self
1286	}
1287
1288	sub conn::stats_update {
1289	my ($self, $stats) = @_;
1290
1291	if (my $exp = $stats->{Crossfire::Protocol::CS_STAT_EXP64}) {
1292	my $diff = $exp - $self->{prev_exp};
1293	$STATUSBOX->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5)
1294	if exists $self->{prev_exp} && $diff;
1295	$self->{prev_exp} = $exp;
1296	}
1297
1298	update_stats_window ($stats);
1299	}
1300
1301	sub conn::user_send {
1302	my ($self, $command) = @_;
1303
1304	$self->send_command ($command);
1305	status $command;
1306	}
1307
1308	sub conn::map_scroll {
1309	my ($self, $dx, $dy) = @_;
1310
1311	$MAP->scroll ($dx, $dy);
1312	}
1313
1314	sub conn::feed_map1a {
1315	my ($self, $data) = @_;
1316
1317	# $self->Crossfire::Protocol::feed_map1a ($data);
1318
1319	$MAP->map1a_update ($data);
1320	$MAPWIDGET->update;
1321	}
1322
1323	sub conn::flush_map {
1324	my ($self) = @_;
1325
1326	my $map_info = delete $self->{map_info}
1327	or return;
1328
1329	my ($hash, $x, $y, $w, $h) = @$map_info;
1330
1331	my $data = $MAP->get_rect ($x, $y, $w, $h);
1332	$MAPCACHE->put ($hash => Compress::LZF::compress $data);
1333	#warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
1334	}
1335
1336	sub conn::map_clear {
1337	my ($self) = @_;
1338
1339	$self->flush_map;
1340	delete $self->{neigh_map};
1341
1342	$MAP->clear;
1343	}
1344
1345
1346	sub conn::load_map($$$) {
1347	my ($self, $hash, $x, $y) = @_;
1348
1349	if (defined (my $data = $MAPCACHE->get ($hash))) {
1350	$data = Compress::LZF::decompress $data;
1351	#warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
1352	for my $id ($MAP->set_rect ($x, $y, $data)) {
1353	my $data = $TILECACHE->get ($id)
1354	or next;
1355
1356	$self->set_texture ($id => $data);
1357	}
1358	}
1359	}
1360
1361	# hardcode /world/world_xxx_xxx map names, the savings are enourmous,
1362	# (server resource,s latency, bandwidth), so this hack is warranted.
1363	# the right fix is to make real tiled maps with an overview file
1364	sub conn::send_mapinfo {
1365	my ($self, $data, $cb) = @_;
1366
1367	if ($self->{map_info}[0] =~ m%^/world/world_(\d\d\d)_(\d\d\d)$%) {
1368	my ($wx, $wy) = ($1, $2);
1369
1370	if ($data =~ /^spatial ([1-4]+)$/) {
1371	my @dx = (0, 0, 1, 0, -1);
1372	my @dy = (0, -1, 0, 1, 0);
1373	my ($dx, $dy);
1374
1375	for (split //, $1) {
1376	$dx += $dx[$_];
1377	$dy += $dy[$_];
1378	}
1379
1380	$cb->(spatial => 15,
1381	$self->{map_info}[1] - $MAP->ox + $dx * 50,
1382	$self->{map_info}[2] - $MAP->oy + $dy * 50,
1383	50, 50,
1384	sprintf "/world/world_%03d_%03d", $wx + $dx, $wy + $dy
1385	);
1386
1387	return;
1388	}
1389	}
1390
1391	$self->Crossfire::Protocol::send_mapinfo ($data, $cb);
1392	}
1393
1394	# this method does a "flood fill" into every tile direction
1395	# it assumes that tiles are arranged in a rectangular grid,
1396	# i.e. a map is the same as the left of the right map etc.
1397	# failure to comply are harmless and result in display errors
1398	# at worst.
1399	sub conn::flood_fill {
1400	my ($self, $block, $gx, $gy, $path, $hash, $flags) = @_;
1401
1402	# the server does not allow map paths > 6
1403	return if 7 <= length $path;
1404
1405	my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
1406
1407	for (
1408	[1, 3, 0, -1],
1409	[2, 4, 1, 0],
1410	[3, 1, 0, 1],
1411	[4, 2, -1, 0],
1412	) {
1413	my ($tile, $tile2, $dx, $dy) = @$_;
1414
1415	next if $block & (1 << $tile);
1416	my $block = $block | (1 << $tile2);
1417
1418	my $gx = $gx + $dx;
1419	my $gy = $gy + $dy;
1420
1421	next unless $flags & (1 << ($tile - 1));
1422	next if $self->{neigh_grid}{$gx, $gy}++;
1423
1424	my $neigh = $self->{neigh_map}{$hash} ||= [];
1425	if (my $info = $neigh->[$tile]) {
1426	my ($flags, $x, $y, $w, $h, $hash) = @$info;
1427
1428	$self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
1429	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1430
1431	} else {
1432	$self->send_mapinfo ("spatial $path$tile", sub {
1433	my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
1434
1435	return if $mode ne "spatial";
1436
1437	$x += $MAP->ox;
1438	$y += $MAP->oy;
1439
1440	$self->load_map ($hash, $x, $y)
1441	unless $self->{neigh_map}{$hash}[5]++;#d#
1442
1443	$neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
1444
1445	$self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
1446	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
1447	});
1448	}
1449	}
1450	}
1451
1452	sub conn::map_change {
1453	my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
1454
1455	$self->flush_map;
1456
1457	my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
1458
1459	my $mapmapw = $MAPMAP->{w};
1460	my $mapmaph = $MAPMAP->{h};
1461
1462	$self->{neigh_rect} = [
1463	$ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
1464	$ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
1465	];
1466
1467	delete $self->{neigh_grid};
1468
1469	$x += $ox;
1470	$y += $oy;
1471
1472	$self->{map_info} = [$hash, $x, $y, $w, $h];
1473
1474	(my $map = $hash) =~ s/^.*?\/([^\/]+)$/\1/;
1475	$STATWIDS->{map}->set_text ("Map: " . $map);
1476
1477	$self->load_map ($hash, $x, $y);
1478	$self->flood_fill (0, 0, 0, "", $hash, $flags);
1479	}
1480
1481	sub conn::face_find {
1482	my ($self, $facenum, $face) = @_;
1483
1484	my $hash = "$face->{chksum},$face->{name}";
1485
1486	my $id = $FACEMAP->get ($hash);
1487
1488	unless ($id) {
1489	# create new id for face
1490	# I love transactions
1491	for (1..100) {
1492	my $txn = $CFClient::DB_ENV->txn_begin;
1493	my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);
1494	if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
1495	$id = ($id || 16) + 1;
1496	if ($FACEMAP->put (id => $id) == 0
1497	&& $FACEMAP->put ($hash => $id) == 0) {
1498	$txn->txn_commit;
1499
1500	goto gotid;
1501	}
1502	}
1503	$txn->abort;
1504	}
1505
1506	CFClient::fatal "maximum number of transaction retries reached - database problems?";
1507	}
1508
1509	gotid:
1510	$face->{id} = $id;
1511	$MAP->set_face ($facenum => $id);
1512	$self->{faceid}[$facenum] = $id;#d#
1513
1514	my $face = $TILECACHE->get ($id);
1515
1516	if ($face) {
1517	#$self->face_prefetch;
1518	$face
1519	} else {
1520	my $tex = $self->{noface};
1521	$MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
1522	undef
1523	};
1524	}
1525
1526	sub conn::face_update {
1527	my ($self, $facenum, $face) = @_;
1528
1529	$TILECACHE->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes
1530
1531	$self->set_texture ($face->{id} => delete $face->{image});
1532	}
1533
1534	sub conn::set_texture {
1535	my ($self, $id, $data) = @_;
1536
1537	$self->{texture}[$id] ||= do {
1538	my $tex =
1539	new_from_image CFClient::Texture
1540	$data, minify => 1, mipmap => 1;
1541
1542	$MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
1543	$MAPWIDGET->update;
1544
1545	$tex
1546	};
1547	}
1548
1549	sub conn::sound_play {
1550	my ($self, $x, $y, $soundnum, $type) = @_;
1551
1552	$SDL_MIXER
1553	or return;
1554
1555	my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
1556	or return;
1557
1558	$chunk->play;
1559	# warn "sound $x,$y,$soundnum,$type\n";#d#
1560	}
1561
1562	my $LAST_QUERY; # server is stupid, stupid, stupid
1563
1564	sub conn::query {
1565	my ($self, $flags, $prompt) = @_;
1566
1567	$prompt = $LAST_QUERY unless length $prompt;
1568	$LAST_QUERY = $prompt;
1569
1570	my $dialog = new CFClient::UI::FancyFrame
1571	title => "Query",
1572	child => my $vbox = new CFClient::UI::VBox;
1573
1574	$vbox->add (new CFClient::UI::Label
1575	max_w => $::WIDTH * 0.4,
1576	ellipsise => 0,
1577	text => $prompt);
1578
1579	if ($flags & Crossfire::Protocol::CS_QUERY_YESNO) {
1580	$vbox->add (my $hbox = new CFClient::HBox);
1581	$hbox->add (new CFClient::Button
1582	text => "No",
1583	connect_activate => sub {
1584	$self->send ("reply n");
1585	$dialog->destroy;
1586	$MAPWIDGET->focus_in;
1587	}
1588	);
1589	$hbox->add (new CFClient::Button
1590	text => "Yes",
1591	connect_activate => sub {
1592	$self->send ("reply y");
1593	$dialog->destroy;
1594	},
1595	);
1596
1597	$dialog->focus_in;
1598
1599	} elsif ($flags & Crossfire::Protocol::CS_QUERY_SINGLECHAR) {
1600	$dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";
1601	$vbox->add (my $entry = new CFClient::UI::Entry
1602	connect_changed => sub {
1603	$self->send ("reply $_[1]");
1604	$dialog->destroy;
1605	},
1606	);
1607
1608	$entry->focus_in;
1609
1610	} else {
1611	$dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
1612
1613	$vbox->add (my $entry = new CFClient::UI::Entry
1614	$flags & Crossfire::Protocol::CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (),
1615	connect_activate => sub {
1616	$self->send ("reply $_[1]");
1617	$dialog->destroy;
1618	},
1619	);
1620
1621	$entry->focus_in;
1622	}
1623
1624	$dialog->show_centered;
1625	}
1626
1627	sub conn::drawinfo {
1628	my ($self, $color, $text) = @_;
1629
1630	my @color = (
1631	[1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
1632	[1.00, 1.00, 1.00],
1633	[0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]
1634	[1.00, 0.00, 0.00],
1635	[1.00, 0.54, 0.00],
1636	[0.11, 0.56, 1.00],
1637	[0.93, 0.46, 0.00],
1638	[0.18, 0.54, 0.34],
1639	[0.56, 0.73, 0.56],
1640	[0.80, 0.80, 0.80],
1641	[0.55, 0.41, 0.13],
1642	[0.99, 0.77, 0.26],
1643	[0.74, 0.65, 0.41],
1644	);
1645
1646	my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
1647
1648	$text = CFClient::UI::Label::escape $text;
1649	$text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g;
1650	$text =~ s/\[color=(.*?)\](.*?)\[\/color\]/<span foreground='\1'>\2<\/span>/g;
1651
1652	$LOGVIEW->add_paragraph ($color[$color],
1653	join "\n", map "$time $_", split /\n/, $text);
1654
1655	$STATUSBOX->add ($text,
1656	group => $text,
1657	fg => $color[$color],
1658	timeout => 10,
1659	tooltip_font => $::FONT_FIXED,
1660	);
1661	}
1662
1663	sub conn::drawextinfo {
1664	my ($self, $color, $type, $subtype, $message) = @_;
1665
1666	$self->drawinfo ($color, $message);
1667	}
1668
1669	sub conn::spell_add {
1670	my ($self, $spell) = @_;
1671
1672	# TODO
1673	# create a widget dynamically, using spell face (CF::Protocol downloads them)
1674	$MAPWIDGET->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1675	$MAPWIDGET->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1676	}
1677
1678	sub conn::spell_delete {
1679	my ($self, $spell) = @_;
1680	}
1681
1682	sub conn::addme_success {
1683	my ($self) = @_;
1684
1685	$self->send ("command output-sync $CFG->{output_sync}");
1686	$self->send ("command output-count $CFG->{output_count}");
1687
1688	my $parser = new Pod::POM;
1689	my $pod = $parser->parse_file (CFClient::find_rcfile "pod/skill_help.pod");
1690
1691	my %skill_tooltip;
1692
1693	for my $head2 ($pod->head1->[-2]->head2) {
1694	$skill_tooltip{$head2->title} = CFClient::pod_to_pango $head2->content;
1695	}
1696
1697	for my $skill (values %{$self->{skill_info}}) {
1698	$MAPWIDGET->add_command ("ready_skill $skill",
1699	(CFClient::UI::Label::escape "Ready the skill '$skill'\n\n")
1700	. $skill_tooltip{$skill});
1701	$MAPWIDGET->add_command ("use_skill $skill",
1702	(CFClient::UI::Label::escape "Immediately use the skill '$skill'\n\n")
1703	. $skill_tooltip{$skill});
1704	}
1705	}
1706
1707	sub conn::eof {
1708	$MAPWIDGET->clr_commands;
1709
1710	stop_game;
1711	}
1712
1713	sub conn::image_info {
1714	my ($self, $numfaces) = @_;
1715
1716	$self->{num_faces} = $numfaces;
1717	$self->{face_prefetch} = [1 .. $numfaces];
1718	$self->face_prefetch;
1719	}
1720
1721	sub conn::face_prefetch {
1722	my ($self) = @_;
1723
1724	return unless $CFG->{face_prefetch};
1725
1726	if ($self->{num_faces}) {
1727	return if @{ $self->{send_queue} || [] };
1728	my $todo = @{ $self->{face_prefetch} }
1729	or return;
1730
1731	my ($face) = splice @{ $self->{face_prefetch} }, + rand @{ $self->{face_prefetch} }, 1, ();
1732
1733	$self->send ("requestinfo image_sums $face $face");
1734
1735	$STATUSBOX->add (CFClient::UI::Label::escape "prefetching $todo",
1736	group => "prefetch", timeout => 2, fg => [1, 1, 0, 0.5]);
1737	} elsif (!exists $self->{num_faces}) {
1738	$self->send ("requestinfo image_info");
1739
1740	$self->{num_faces} = 0;
1741
1742	$STATUSBOX->add (CFClient::UI::Label::escape "starting to prefetch",
1743	group => "prefetch", timeout => 2, fg => [1, 1, 0, 0.5]);
1744	}
1745	}
1746
1747	# check once/second for faces that need to be prefetched	1349	# check once/second for faces that need to be prefetched
1748	# this should, of course, only run on demand, but	1350	# this should, of course, only run on demand, but
1749	# SDL forces worse things on us....	1351	# SDL forces worse things on us....
1750		1352
1751	Event->timer (after => 1, interval => 0.25, cb => sub {	1353	Event->timer (after => 1, interval => 0.25, cb => sub {
1752	$CONN->face_prefetch	1354	$CONN->face_prefetch
1753	if $CONN;	1355	if $CONN;
1754	});	1356	});
1755
1756	sub update_floorbox {
1757	$CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
1758	return unless $CONN;
1759
1760	$FLOORBOX->clear;
1761
1762	my $row;
1763	for (@{ $CONN->{container}{0} }) {
1764	if ($row < 7) {
1765	local $_->{face_widget}; # hack to force recreation of widget
1766	local $_->{desc_widget}; # hack to force recreation of widget
1767	CFClient::Item::update_widgets $_;
1768
1769	$FLOORBOX->add (0, $row, $_->{face_widget});
1770	$FLOORBOX->add (1, $row, $_->{desc_widget});
1771
1772	$row++;
1773	} else {
1774	$FLOORBOX->add (1, $row, new CFClient::UI::Label text => "More...");
1775	last;
1776	}
1777	}
1778	});
1779
1780	$WANT_REFRESH++;
1781	}
1782
1783	sub set_opencont {
1784	my ($conn, $tag, $name) = @_;
1785	$conn->{open_container} = $tag;
1786	$INVR_LBL->set_text ($name);
1787	$INVR->set_items ($conn->{container}{$tag});
1788	}
1789
1790	sub update_container {
1791	my ($tag) = @_;
1792	$INVR->set_items ($::CONN->{container}{$CONN->{open_container}})
1793	if $tag == $CONN->{open_container};
1794	}
1795
1796	sub conn::container_add {
1797	my ($self, $tag, $items) = @_;
1798
1799	#d# print "container_add: container $tag ($self->{player}{tag})\n";
1800
1801	if ($tag == 0) {
1802	update_floorbox;
1803	update_container (0);
1804	} elsif ($tag == $self->{player}{tag}) {
1805	$INV->set_items ($self->{container}{$self->{player}{tag}})
1806	} else {
1807	update_container ($tag);
1808	}
1809
1810	# $self-<{player}{tag} => player inv
1811	#use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1812	}
1813
1814	sub conn::container_clear {
1815	my ($self, $tag) = @_;
1816
1817	#d# print "container_clear: container $tag ($self->{player}{tag})\n";
1818
1819	if ($tag == 0) {
1820	update_floorbox;
1821	update_container (0);
1822	} elsif ($tag == $self->{player}{tag}) {
1823	$INV->set_items ($self->{container}{$tag})
1824	}
1825
1826	# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1827	}
1828
1829	sub conn::item_delete {
1830	my ($self, @items) = @_;
1831
1832	for (@items) {
1833	#d# print "item_delete: $_->{tag} from $_->{container} ($self->{player}{tag})\n";
1834
1835	if ($_->{container} == 0) {
1836	update_floorbox;
1837	update_container ($_->{tag});
1838	} elsif ($_->{container} == $self->{player}{tag}) {
1839	$INV->set_items ($self->{container}{$self->{player}{tag}})
1840	} else {
1841	update_container ($_->{tag});
1842	}
1843	}
1844	}
1845
1846	sub conn::item_update {
1847	my ($self, $item) = @_;
1848
1849	#d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($CONN->{open_container})\n";
1850
1851	if ($item->{tag} == $self->{player}{tag}) {
1852	$STATWIDS->{weight}->set_text (sprintf "Weight: %.1fkg", $item->{weight} / 1000);
1853	return
1854	}
1855
1856	CFClient::Item::update_widgets $item;
1857
1858	if ($item->{tag} == $CONN->{open_container} && not ($item->{flags} & Crossfire::Protocol::F_OPEN)) {
1859	set_opencont ($CONN, 0, "Floor");
1860
1861	} elsif ($item->{flags} & Crossfire::Protocol::F_OPEN) {
1862	set_opencont ($CONN, $item->{tag}, CFClient::Item::desc_string $item);
1863	} else {
1864	if ($item->{container} == 0) {
1865	update_floorbox;
1866	update_container (0);
1867	} elsif ($item->{container} == $self->{player}{tag}) {
1868	$INV->set_items ($self->{container}{$item->{container}})
1869	}
1870	}
1871	}
1872		1357
1873	%SDL_CB = (	1358	%SDL_CB = (
1874	CFClient::SDL_QUIT => sub {	1359	CFClient::SDL_QUIT => sub {
1875	Event::unloop -1;	1360	Event::unloop -1;
1876	},	1361	},
…		…
1911		1396
1912	{	1397	{
1913	local $SIG{__DIE__} = sub { CFClient::fatal $_[0] };	1398	local $SIG{__DIE__} = sub { CFClient::fatal $_[0] };
1914		1399
1915	CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";	1400	CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
1916		1401	CFClient::UI::set_layout ($::CFG->{layout});
1917	$TILECACHE = CFClient::db_table "tilecache";
1918	$FACEMAP = CFClient::db_table "facemap";
1919		1402
1920	my %DEF_CFG = (	1403	my %DEF_CFG = (
1921	sdl_mode => 0,	1404	sdl_mode => 0,
1922	width => 640,	1405	width => 640,
1923	height => 480,	1406	height => 480,

Diff Legend

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