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

Diff Legend

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