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

Diff Legend

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