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.35 by elmex, Tue May 30 14:45:56 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	our $BIND_EDITOR;
109		110
110	sub status {	111	sub status {
111	$STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);	112	$STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
112	}	113	}
113		114
114	sub debug {	115	sub debug {
115	$DEBUG_STATUS->set_text ($_[0]);	116	$DEBUG_STATUS->set_text ($_[0]);
116	my ($w, $h) = $DEBUG_STATUS->size_request;
117	$DEBUG_STATUS->move ($WIDTH - $w, 0);
118	}	117	}
119		118
120	sub start_game {	119	sub start_game {
121	status "logging in...";	120	status "logging in...";
122		121
		122	$LOGIN_BUTTON->set_text ("Logout");
		123	$SERVER_SETUP->hide;
		124
123	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;	125	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
124		126
125	$MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";	127	my ($host, $port) = split /:/, $CFG->{host};
		128
126	$MAP = new CFClient::Map $mapsize, $mapsize;	129	$MAP = new CFClient::Map $mapsize, $mapsize;
127
128	my ($host, $port) = split /:/, $CFG->{host};
129		130
130	$CONN = eval {	131	$CONN = eval {
131	new conn	132	new CFClient::Protocol
132	host => $host,	133	host => $host,
133	port => $port || 13327,	134	port => $port || 13327,
134	user => $CFG->{user},	135	user => $CFG->{user},
135	pass => $CFG->{password},	136	pass => $CFG->{password},
136	mapw => $mapsize,	137	mapw => $mapsize,
137	maph => $mapsize,	138	maph => $mapsize,
138	;	139
		140	map_widget => $MAPWIDGET,
		141	logview => $LOGVIEW,
		142	statusbox => $STATUSBOX,
		143	map => $MAP,
		144	mapmap => $MAPMAP,
		145
		146	sound_play => sub {
		147	my ($x, $y, $soundnum, $type) = @_;
		148
		149	$SDL_MIXER
		150	or return;
		151
		152	my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
		153	or return;
		154
		155	$chunk->play;
		156	},
139	};	157	};
140		158
141	if ($CONN) {	159	if ($CONN) {
142	CFClient::lowdelay fileno $CONN->{fh};	160	CFClient::lowdelay fileno $CONN->{fh};
143		161
144	$LOGIN_BUTTON->set_text ("Logout");
145	status "login successful";	162	status "login successful";
146
147	$BUTTONBAR->{children}[1]->emit ("activate")
148	if $BUTTONBAR->{children}[1]->{state};
149
150	} else {	163	} else {
151	status "unable to connect";	164	status "unable to connect";
152	stop_game();	165	stop_game();
153	}	166	}
154	}	167	}
155		168
156	sub stop_game {	169	sub stop_game {
		170	$LOGIN_BUTTON->set_text ("Login");
		171	$SERVER_SETUP->show;
		172	$INV_WINDOW->hide;
		173	$LOGVIEW->hide;
		174
157	return unless $CONN;	175	return unless $CONN;
158		176
159	status "connection closed";	177	status "connection closed";
160	$LOGIN_BUTTON->set_text ("Login");	178
161	$CONN->destroy;	179	$CONN->destroy;
162	$CONN = 0; # false, does not autovivify	180	$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	}	181	}
170		182
171	sub client_setup {	183	sub client_setup {
172	my $dialog = new CFClient::UI::FancyFrame	184	my $dialog = new CFClient::UI::FancyFrame
		185	x => 1,
		186	y => $HEIGHT * (1/8),
		187	name => "client_setup",
173	title => "Client Setup",	188	title => "Client Setup",
174	child => (my $vbox = new CFClient::UI::VBox);	189	child => (my $vbox = new CFClient::UI::VBox);
		190
175	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);	191	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
176		192
177	$table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");	193	$table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");
178	$table->add (1, 0, my $hbox = new CFClient::UI::HBox);	194	$table->add (1, 0, my $hbox = new CFClient::UI::HBox);
179		195
180	$hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1]);	196	$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");	197	$hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");
182		198
183	$mode_slider->connect (changed => sub {	199	$mode_slider->connect (changed => sub {
184	my ($self, $value) = @_;	200	my ($self, $value) = @_;
185		201
…		…
192		208
193	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");	209	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
194	$table->add (1, $row++, new CFClient::UI::CheckBox	210	$table->add (1, $row++, new CFClient::UI::CheckBox
195	state => $CFG->{fullscreen},	211	state => $CFG->{fullscreen},
196	tooltip => "Bring the client into fullscreen mode.",	212	tooltip => "Bring the client into fullscreen mode.",
197	connect_changed => sub {	213	on_changed => sub {
198	my ($self, $value) = @_;	214	my ($self, $value) = @_;
199	$CFG->{fullscreen} = $value;	215	$CFG->{fullscreen} = $value;
200	}	216	}
201	);	217	);
202		218
203	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");	219	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
204	$table->add (1, $row++, new CFClient::UI::CheckBox	220	$table->add (1, $row++, new CFClient::UI::CheckBox
205	state => $CFG->{fast},	221	state => $CFG->{fast},
206	tooltip => "Lower the visual quality considerably to speed up rendering.",	222	tooltip => "Lower the visual quality considerably to speed up rendering.",
207	connect_changed => sub {	223	on_changed => sub {
208	my ($self, $value) = @_;	224	my ($self, $value) = @_;
209	$CFG->{fast} = $value;	225	$CFG->{fast} = $value;
210	}	226	}
211	);	227	);
212		228
213	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");	229	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
214	$table->add (1, $row++, new CFClient::UI::Slider	230	$table->add (1, $row++, new CFClient::UI::Slider
215	range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],	231	range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
216	tooltip => "Enlarge or shrink the displayed map. Changes are instant.",	232	tooltip => "Enlarge or shrink the displayed map. Changes are instant.",
217	connect_changed => sub {	233	on_changed => sub {
218	my ($self, $value) = @_;	234	my ($self, $value) = @_;
219	$CFG->{map_scale} = 2 ** $value;	235	$CFG->{map_scale} = 2 ** $value;
220	}	236	}
221	);	237	);
222		238
223	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");	239	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
224	$table->add (1, $row++, new CFClient::UI::CheckBox	240	$table->add (1, $row++, new CFClient::UI::CheckBox
225	state => $CFG->{fow_enable},	241	state => $CFG->{fow_enable},
226	tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",	242	tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",
227	connect_changed => sub {	243	on_changed => sub {
228	my ($self, $value) = @_;	244	my ($self, $value) = @_;
229	$CFG->{fow_enable} = $value;	245	$CFG->{fow_enable} = $value;
230	}	246	}
231	);	247	);
232		248
233	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");	249	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
234	$table->add (1, $row++, new CFClient::UI::Slider	250	$table->add (1, $row++, new CFClient::UI::Slider
235	range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],	251	range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],
236	tooltip => "<b>Fog of War Lightness.</b> The higher the intensity, the lighter the Fog-of-War color. Changes are instant.",	252	tooltip => "<b>Fog of War Lightness.</b> The higher the intensity, the lighter the Fog-of-War color. Changes are instant.",
237	connect_changed => sub {	253	on_changed => sub {
238	my ($self, $value) = @_;	254	my ($self, $value) = @_;
239	$CFG->{fow_intensity} = $value;	255	$CFG->{fow_intensity} = $value;
240	}	256	}
241	);	257	);
242		258
243	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");	259	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
244	$table->add (1, $row++, new CFClient::UI::CheckBox	260	$table->add (1, $row++, new CFClient::UI::CheckBox
245	state => $CFG->{fow_smooth},	261	state => $CFG->{fow_smooth},
246	tooltip => "Smooth the Fog-of-War a bit to make it more realistic. Changes are instant.",	262	tooltip => "Smooth the Fog-of-War a bit to make it more realistic. Changes are instant.",
247	connect_changed => sub {	263	on_changed => sub {
248	my ($self, $value) = @_;	264	my ($self, $value) = @_;
249	$CFG->{fow_smooth} = $value;	265	$CFG->{fow_smooth} = $value;
250	status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2;	266	status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::OpenGL::GL_VERSION < 1.2;
251	}	267	}
252	);	268	);
253		269
254	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");	270	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
255	$table->add (1, $row++, new CFClient::UI::Slider	271	$table->add (1, $row++, new CFClient::UI::Slider
256	range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],	272	range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],
257	tooltip => "The base font size used by most GUI elements that do not have their own setting.",	273	tooltip => "The base font size used by most GUI elements that do not have their own setting.",
258	connect_changed => sub { $CFG->{gui_fontsize} = $_[1] },	274	on_changed => sub { $CFG->{gui_fontsize} = $_[1] },
259	);	275	);
260		276
261	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Message Fontsize");	277	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Message Fontsize");
262	$table->add (1, $row++, new CFClient::UI::Slider	278	$table->add (1, $row++, new CFClient::UI::Slider
263	range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],	279	range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],
264	tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant.",	280	tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant.",
265	connect_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]) },	281	on_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]) },
266	);	282	);
267		283
268	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");	284	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
269		285
270	$table->add (1, $row++, new CFClient::UI::Slider	286	$table->add (1, $row++, new CFClient::UI::Slider
271	range => [$CFG->{stat_fontsize}, 0.5, 2, 0, 0.1],	287	range => [$CFG->{stat_fontsize}, 0.5, 2, 0, 0.1],
272	tooltip => "The font size used by the <b>statistics window</b> only. Changes are instant.",	288	tooltip => "The font size used by the <b>statistics window</b> only. Changes are instant.",
273	connect_changed => sub {	289	on_changed => sub {
274	$CFG->{stat_fontsize} = $_[1];	290	$CFG->{stat_fontsize} = $_[1];
275	&set_stats_window_fontsize;	291	&set_stats_window_fontsize;
276	}	292	}
277	);	293	);
278		294
279	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");	295	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
280	$table->add (1, $row++, new CFClient::UI::Slider	296	$table->add (1, $row++, new CFClient::UI::Slider
281	range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],	297	range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],
282	tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.",	298	tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.",
283	connect_changed => sub {	299	on_changed => sub {
284	$CFG->{gauge_fontsize} = $_[1];	300	$CFG->{gauge_fontsize} = $_[1];
285	&set_gauge_window_fontsize;	301	&set_gauge_window_fontsize;
286	}	302	}
287	);	303	);
288		304
289	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");	305	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
290	$table->add (1, $row++, new CFClient::UI::Slider	306	$table->add (1, $row++, new CFClient::UI::Slider
291	range => [$CFG->{gauge_size}, 0.2, 0.8],	307	range => [$CFG->{gauge_size}, 0.2, 0.8],
292	tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",	308	tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",
293	connect_changed => sub {	309	on_changed => sub {
294	$CFG->{gauge_size} = $_[1];	310	$CFG->{gauge_size} = $_[1];
295	$GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});	311	$GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
296	}	312	}
297	);	313	);
298		314
299	$table->add (1, $row++, new CFClient::UI::Button	315	$table->add (1, $row++, new CFClient::UI::Button
300	expand => 1, align => 0, text => "Apply",	316	expand => 1, align => 0, text => "Apply",
301	tooltip => "Apply the video settings",	317	tooltip => "Apply the video settings",
302	connect_activate => sub {	318	on_activate => sub {
303	video_shutdown ();	319	video_shutdown ();
304	video_init ();	320	video_init ();
305	}	321	}
306	);	322	);
307		323
308	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");	324	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");
309	$table->add (1, $row++, new CFClient::UI::CheckBox	325	$table->add (1, $row++, new CFClient::UI::CheckBox
310	state => $CFG->{audio_enable},	326	state => $CFG->{audio_enable},
311	tooltip => "<b>Master Audio Enable.</b> If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.",	327	tooltip => "<b>Master Audio Enable.</b> If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.",
312	connect_changed => sub {	328	on_changed => sub {
313	$CFG->{audio_enable} = $_[1];	329	$CFG->{audio_enable} = $_[1];
314	}	330	}
315	);	331	);
316	# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume");	332	# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume");
317	# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], connect_changed => sub {	333	# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], on_changed => sub {
318	# $CFG->{effects_volume} = $_[1];	334	# $CFG->{effects_volume} = $_[1];
319	# });	335	# });
320	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");	336	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");
321	$table->add (1, $row++, my $hbox = new CFClient::UI::HBox);	337	$table->add (1, $row++, my $hbox = new CFClient::UI::HBox);
322	$hbox->add (new CFClient::UI::CheckBox	338	$hbox->add (new CFClient::UI::CheckBox
323	expand => 1, state => $CFG->{bgm_enable},	339	expand => 1, state => $CFG->{bgm_enable},
324	tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",	340	tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",
325	connect_changed => sub {	341	on_changed => sub {
326	$CFG->{bgm_enable} = $_[1];	342	$CFG->{bgm_enable} = $_[1];
327	}	343	}
328	);	344	);
329	$hbox->add (new CFClient::UI::Slider	345	$hbox->add (new CFClient::UI::Slider
330	expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],	346	expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],
331	tooltip => "The volume of the background music. Changes are instant.",	347	tooltip => "The volume of the background music. Changes are instant.",
332	connect_changed => sub {	348	on_changed => sub {
333	$CFG->{bgm_volume} = $_[1];	349	$CFG->{bgm_volume} = $_[1];
334	CFClient::MixMusic::volume $_[1] * 128;	350	CFClient::MixMusic::volume $_[1] * 128;
335	}	351	}
336	);	352	);
337		353
338	$table->add (1, $row++, new CFClient::UI::Button	354	$table->add (1, $row++, new CFClient::UI::Button
339	expand => 1, align => 0, text => "Apply",	355	expand => 1, align => 0, text => "Apply",
340	tooltip => "Apply the audio settings",	356	tooltip => "Apply the audio settings",
341	connect_activate => sub {	357	on_activate => sub {
342	audio_shutdown ();	358	audio_shutdown ();
343	audio_init ();	359	audio_init ();
344	}	360	}
345	);	361	);
346		362
…		…
348	$table->add (1, $row++, my $saycmd = new CFClient::UI::Entry	364	$table->add (1, $row++, my $saycmd = new CFClient::UI::Entry
349	text => $CFG->{say_command},	365	text => $CFG->{say_command},
350	tooltip => "This is the command that will be used if you write a line in the message window entry or press <b>\"</b> in the map window. "	366	tooltip => "This is the command that will be used if you write a line in the message window entry or press <b>\"</b> in the map window. "
351	. "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "	367	. "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
352	. "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",	368	. "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
353	connect_changed => sub {	369	on_changed => sub {
354	my ($self, $value) = @_;	370	my ($self, $value) = @_;
355	$CFG->{say_command} = $value;	371	$CFG->{say_command} = $value;
356	}	372	}
357	);	373	);
358		374
…		…
373		389
374	sub make_gauge_window {	390	sub make_gauge_window {
375	my $gh = int $HEIGHT * $CFG->{gauge_size};	391	my $gh = int $HEIGHT * $CFG->{gauge_size};
376		392
377	my $win = new CFClient::UI::Frame (	393	my $win = new CFClient::UI::Frame (
378	req_y => -1,	394	force_x => 0,
		395	force_y => "max",
379	user_w => $WIDTH,	396	force_w => $WIDTH,
380	user_h => $gh,	397	force_h => $gh,
381	);	398	);
382		399
383	$win->add (my $hbox = new CFClient::UI::HBox	400	$win->add (my $hbox = new CFClient::UI::HBox
384	children => [	401	children => [
385	(new CFClient::UI::HBox expand => 1),	402	(new CFClient::UI::HBox expand => 1),
…		…
421	&set_gauge_window_fontsize;	438	&set_gauge_window_fontsize;
422		439
423	$win	440	$win
424	}	441	}
425		442
		443
426	sub make_stats_window {	444	sub make_stats_window {
427	my $tgw = new CFClient::UI::FancyFrame title => "Stats";	445	my $tgw = new CFClient::UI::FancyFrame
		446	y => $HEIGHT * (2/8),
		447	x => "max",
		448	title => "Stats",
		449	name => "stats_window";
428		450
429	$tgw->add (new CFClient::UI::Window child => my $vb = new CFClient::UI::VBox);	451	$tgw->add (new CFClient::UI::Window child => my $vb = new CFClient::UI::VBox);
430	$vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,	452	$vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,
431	can_hover => 1, can_events => 1,	453	can_hover => 1, can_events => 1,
432	tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");	454	tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");
433	$vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,	455	$vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,
434	can_hover => 1, can_events => 1,	456	can_hover => 1, can_events => 1,
435	tooltip => "The map you are currently on (if supported by the server).");	457	tooltip => "The map you are currently on (if supported by the server).");
		458
		459	$vb->add (my $hb0 = new CFClient::UI::HBox);
		460	$hb0->add ($STATWIDS->{weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1,
		461	can_hover => 1, can_events => 1,
		462	tooltip => "The weight of the player including all inventory items.");
		463	$hb0->add ($STATWIDS->{m_weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1,
		464	can_hover => 1, can_events => 1,
		465	tooltip => "The weight limit: you cannot carry more than this.");
		466
436		467
437	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);	468	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
438	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);	469	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);
439		470
440	my $color2 = [1, 1, 0];	471	my $color2 = [1, 1, 0];
…		…
529	}	560	}
530		561
531	sub update_stats_window {	562	sub update_stats_window {
532	my ($stats) = @_;	563	my ($stats) = @_;
533		564
534	# i love text protocols!!!	565	# I love text protocols...
		566
535	my $hp = $stats->{Crossfire::Protocol::CS_STAT_HP} * 1;	567	my $hp = $stats->{+CS_STAT_HP} * 1;
536	my $hp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXHP} * 1;	568	my $hp_m = $stats->{+CS_STAT_MAXHP} * 1;
537	my $sp = $stats->{Crossfire::Protocol::CS_STAT_SP} * 1;	569	my $sp = $stats->{+CS_STAT_SP} * 1;
538	my $sp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXSP} * 1;	570	my $sp_m = $stats->{+CS_STAT_MAXSP} * 1;
539	my $fo = $stats->{Crossfire::Protocol::CS_STAT_FOOD} * 1;	571	my $fo = $stats->{+CS_STAT_FOOD} * 1;
540	my $fo_m = 999;	572	my $fo_m = 999;
541	my $gr = $stats->{Crossfire::Protocol::CS_STAT_GRACE} * 1;	573	my $gr = $stats->{+CS_STAT_GRACE} * 1;
542	my $gr_m = $stats->{Crossfire::Protocol::CS_STAT_MAXGRACE} * 1;	574	my $gr_m = $stats->{+CS_STAT_MAXGRACE} * 1;
543		575
544	$GAUGES->{hp} ->set_value ($hp, $hp_m);	576	$GAUGES->{hp} ->set_value ($hp, $hp_m);
545	$GAUGES->{mana} ->set_value ($sp, $sp_m);	577	$GAUGES->{mana} ->set_value ($sp, $sp_m);
546	$GAUGES->{food} ->set_value ($fo, $fo_m);	578	$GAUGES->{food} ->set_value ($fo, $fo_m);
547	$GAUGES->{grace} ->set_value ($gr, $gr_m);	579	$GAUGES->{grace} ->set_value ($gr, $gr_m);
548	$GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::CS_STAT_EXP64})	580	$GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{+CS_STAT_EXP64})
549	. " (lvl " . ($stats->{Crossfire::Protocol::CS_STAT_LEVEL} * 1) . ")");	581	. " (lvl " . ($stats->{+CS_STAT_LEVEL} * 1) . ")");
550	my $rng = $stats->{Crossfire::Protocol::CS_STAT_RANGE};	582	my $rng = $stats->{+CS_STAT_RANGE};
551	$rng =~ s/^Range: //; # thank you so much dear server	583	$rng =~ s/^Range: //; # thank you so much dear server
552	$GAUGES->{range} ->set_text ("Rng: " . $rng);	584	$GAUGES->{range} ->set_text ("Rng: " . $rng);
553	my $title = $stats->{Crossfire::Protocol::CS_STAT_TITLE};	585	my $title = $stats->{+CS_STAT_TITLE};
554	$title =~ s/^Player: //;	586	$title =~ s/^Player: //;
555	$STATWIDS->{title} ->set_text ("Title: " . $title);	587	$STATWIDS->{title} ->set_text ("Title: " . $title);
556		588
557	$STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});	589	$STATWIDS->{st_str} ->set_text (sprintf "%d" , $stats->{+CS_STAT_STR});
558	$STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});	590	$STATWIDS->{st_dex} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DEX});
559	$STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9});	591	$STATWIDS->{st_con} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CON});
560	$STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6});	592	$STATWIDS->{st_int} ->set_text (sprintf "%d" , $stats->{+CS_STAT_INT});
561	$STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7});	593	$STATWIDS->{st_wis} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WIS});
562	$STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22});	594	$STATWIDS->{st_pow} ->set_text (sprintf "%d" , $stats->{+CS_STAT_POW});
563	$STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});	595	$STATWIDS->{st_cha} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CHA});
564	$STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13});	596	$STATWIDS->{st_wc} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WC});
565	$STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14});	597	$STATWIDS->{st_ac} ->set_text (sprintf "%d" , $stats->{+CS_STAT_AC});
566	$STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});	598	$STATWIDS->{st_dam} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DAM});
567	$STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});	599	$STATWIDS->{st_arm} ->set_text (sprintf "%d" , $stats->{+CS_STAT_ARMOUR});
568	$STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_SPEED});	600	$STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{+CS_STAT_SPEED});
569	$STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_WEAP_SP});	601	$STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{+CS_STAT_WEAP_SP});
570		602
		603	$STATWIDS->{m_weight}->set_text (sprintf "Max weight: %.1fkg", $stats->{+CS_STAT_WEIGHT_LIM} / 1000);
		604
		605	# TODO: replace by CS_STAT_RES_xxx constants
571	my %tbl = (	606	my %tbl = (
572	phys => 100,	607	phys => 100,
573	magic => 101,	608	magic => 101,
574	fire => 102,	609	fire => 102,
575	elec => 103,	610	elec => 103,
…		…
584	tund => 112,	619	tund => 112,
585	fear => 113,	620	fear => 113,
586	depl => 113,	621	depl => 113,
587	deat => 115,	622	deat => 115,
588	holyw => 116,	623	holyw => 116,
589	blind => 117	624	blind => 117,
590	);	625	);
591		626
592	for (keys %tbl) {
593	$STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}});	627	$STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}})
594	}	628	for keys %tbl;
595
596	}	629	}
597		630
598	sub metaserver_dialog {	631	sub metaserver_dialog {
599	my $dialog = new CFClient::UI::FancyFrame	632	my $dialog = new CFClient::UI::FancyFrame
600	title => "Server List",	633	title => "Server List",
…		…
668	$m = [$users, $host, $uptime, $version, $desc];	701	$m = [$users, $host, $uptime, $version, $desc];
669		702
670	$y++;	703	$y++;
671		704
672	$table->add (0, $y, new CFClient::UI::VBox children => [	705	$table->add (0, $y, new CFClient::UI::VBox children => [
673	(new CFClient::UI::Button text => "Use", connect_activate => sub {	706	(new CFClient::UI::Button text => "Use", on_activate => sub {
674	$HOST->set_text ($CFG->{host} = $host);	707	$HOST->set_text ($CFG->{host} = $host);
675	}),	708	}),
676	(new CFClient::UI::Empty expand => 1),	709	(new CFClient::UI::Empty expand => 1),
677	]);	710	]);
678		711
…		…
683	}	716	}
684	});	717	});
685	}	718	}
686		719
687	sub server_setup {	720	sub server_setup {
688	my $dialog = new CFClient::UI::FancyFrame	721	my $dialog = $SERVER_SETUP = new CFClient::UI::FancyFrame
		722	x => "center",
		723	y => "center",
		724	name => "server_setup",
689	title => "Server Setup",	725	title => "Server Setup",
690	child => (my $vbox = new CFClient::UI::VBox);	726	child => (my $vbox = new CFClient::UI::VBox),
691		727	;
		728
692	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);	729	$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");	730	$table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
694		731
695	{	732	{
696	$table->add (1, 2, my $vbox = new CFClient::UI::VBox);	733	$table->add (1, 2, my $vbox = new CFClient::UI::VBox);
…		…
698	$vbox->add (	735	$vbox->add (
699	my $HOST = new CFClient::UI::Entry	736	my $HOST = new CFClient::UI::Entry
700	expand => 1,	737	expand => 1,
701	text => $CFG->{host},	738	text => $CFG->{host},
702	tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",	739	tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
703	connect_changed => sub {	740	on_changed => sub {
704	my ($self, $value) = @_;	741	my ($self, $value) = @_;
705	$CFG->{host} = $value;	742	$CFG->{host} = $value;
706	}	743	}
707	);	744	);
708		745
…		…
711	$vbox->add (new CFClient::UI::Flopper	748	$vbox->add (new CFClient::UI::Flopper
712	expand => 1,	749	expand => 1,
713	text => "Server List",	750	text => "Server List",
714	other => $METASERVER,	751	other => $METASERVER,
715	tooltip => "Show a list of available crossfire servers",	752	tooltip => "Show a list of available crossfire servers",
716	connect_open => sub {	753	on_open => sub {
717	update_metaserver $HOST;	754	update_metaserver $HOST;
718	}	755	}
719	);	756	);
720	}	757	}
721		758
722	$table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");	759	$table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
723	$table->add (1, 4, new CFClient::UI::Entry	760	$table->add (1, 4, new CFClient::UI::Entry
724	text => $CFG->{user},	761	text => $CFG->{user},
725	tooltip => "The name of your character on the server",	762	tooltip => "The name of your character on the server",
726	connect_changed => sub {	763	on_changed => sub {
727	my ($self, $value) = @_;	764	my ($self, $value) = @_;
728	$CFG->{user} = $value;	765	$CFG->{user} = $value;
729	}	766	}
730	);	767	);
731		768
732	$table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");	769	$table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
733	$table->add (1, 5, new CFClient::UI::Entry	770	$table->add (1, 5, new CFClient::UI::Entry
734	text => $CFG->{password},	771	text => $CFG->{password},
735	hidden => 1,	772	hidden => 1,
736	tooltip => "The password for your character",	773	tooltip => "The password for your character",
737	connect_changed => sub {	774	on_changed => sub {
738	my ($self, $value) = @_;	775	my ($self, $value) = @_;
739	$CFG->{password} = $value;	776	$CFG->{password} = $value;
740	}	777	}
741	);	778	);
742		779
743	$table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");	780	$table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
744	$table->add (1, 7, new CFClient::UI::Slider	781	$table->add (1, 7, new CFClient::UI::Slider
745	req_w => 100,	782	force_w => 100,
746	range => [$CFG->{mapsize}, 10, 100, 0, 1],	783	range => [$CFG->{mapsize}, 10, 100, 0, 1],
747	tooltip => "This is the size of the portion of the map update the server sends you. "	784	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, "	785	. "If you set this to a high value you will be able to see further, "
749	. "but you also increase bandwidth requirements and latency. "	786	. "but you also increase bandwidth requirements and latency. "
750	. "This option is only used once at log-in.",	787	. "This option is only used once at log-in.",
751	connect_changed => sub {	788	on_changed => sub {
752	my ($self, $value) = @_;	789	my ($self, $value) = @_;
753		790
754	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;	791	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;
755	},	792	},
756	);	793	);
…		…
763	. "This might increase or create lag, but increases the chances "	800	. "This might increase or create lag, but increases the chances "
764	. "of faces being ready for display when you encounter them. "	801	. "of faces being ready for display when you encounter them. "
765	. "It also uses up server bandwidth on every connect, "	802	. "It also uses up server bandwidth on every connect, "
766	. "so only set it if you really need to prefetch images. "	803	. "so only set it if you really need to prefetch images. "
767	. "This option can be set and unset any time.",	804	. "This option can be set and unset any time.",
768	connect_changed => sub { $CFG->{face_prefetch} = $_[1] },	805	on_changed => sub { $CFG->{face_prefetch} = $_[1] },
769	);	806	);
770		807
771	$table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");	808	$table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");
772	$table->add (1, 9, new CFClient::UI::Entry	809	$table->add (1, 9, new CFClient::UI::Entry
773	text => $CFG->{output_count},	810	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.",	811	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] },	812	on_changed => sub { $CFG->{output_count} = $_[1] },
776	);	813	);
777		814
778	$table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");	815	$table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");
779	$table->add (1, 10, new CFClient::UI::Entry	816	$table->add (1, 10, new CFClient::UI::Entry
780	text => $CFG->{output_sync},	817	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.",	818	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] },	819	on_changed => sub { $CFG->{output_sync} = $_[1] },
783	);	820	);
784		821
785	$table->add (1, 11, $LOGIN_BUTTON = new CFClient::UI::Button	822	$table->add (1, 11, $LOGIN_BUTTON = new CFClient::UI::Button
786	expand => 1,	823	expand => 1,
787	align => 0,	824	align => 0,
788	text => "Login",	825	text => "Login",
789	connect_activate => sub {	826	on_activate => sub {
790	$CONN ? stop_game	827	$CONN ? stop_game
791	: start_game;	828	: start_game;
792	},	829	},
793	);	830	);
794		831
795	$dialog	832	$dialog
796	}	833	}
797		834
798	sub message_window {	835	sub message_window {
799	my $window = new CFClient::UI::FancyFrame	836	my $window = new CFClient::UI::FancyFrame
		837	name => "message_window",
800	title => "Messages",	838	title => "Messages",
801	border_bg => [1, 1, 1, 1],	839	border_bg => [1, 1, 1, 1],
802	bg => [0, 0, 0, 0.75],	840	bg => [0, 0, 0, 0.75],
		841	x => "max",
		842	y => 0,
803	user_w => int $::WIDTH / 3,	843	force_w => $::WIDTH / 3,
804	user_h => int $::HEIGHT / 5,	844	force_h => $::HEIGHT / 5,
805	child => (my $vbox = new CFClient::UI::VBox);	845	child => (my $vbox = new CFClient::UI::VBox);
806		846
807	$vbox->add ($LOGVIEW);	847	$vbox->add ($LOGVIEW);
808		848
809	$vbox->add (my $input = new CFClient::UI::Entry	849	$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> "	850	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>...). "	851	. "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). "	852	. "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.",	853	. "A better way to submit commands (and the occasional chat command) is often the map command completer.",
814	connect_focus_in => sub {	854	on_focus_in => sub {
815	my ($input, $prev_focus) = @_;	855	my ($input, $prev_focus) = @_;
816		856
817	delete $input->{refocus_map};	857	delete $input->{refocus_map};
818		858
819	if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {	859	if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
820	$input->{refocus_map} = 1;	860	$input->{refocus_map} = 1;
821	}	861	}
822	delete $input->{auto_activated};	862	delete $input->{auto_activated};
823	},	863	},
824	connect_activate => sub {	864	on_activate => sub {
825	my ($input, $text) = @_;	865	my ($input, $text) = @_;
826	$input->set_text ('');	866	$input->set_text ('');
827		867
		868	if ($text =~ /^\/bind\s+(.*)$/) {
		869	CFClient::Binder::open_binding_dialog (sub {
		870	my ($mod, $sym) = @_;
		871	$::CFG->{bindings}->{$mod}->{$sym} = [$1];
		872	});
828	if ($text =~ /^\/(.*)/) {	873	} elsif ($text =~ /^\/(.*)/) {
829	$::CONN->user_send ($1);	874	$::CONN->user_send ($1);
830	} else {	875	} else {
831	my $say_cmd = $::CFG->{say_command} || 'say';	876	my $say_cmd = $::CFG->{say_command} || 'say';
832	$::CONN->user_send ("$say_cmd $text");	877	$::CONN->user_send ("$say_cmd $text");
833	}	878	}
834	if ($input->{refocus_map}) {	879	if ($input->{refocus_map}) {
835	delete $input->{refocus_map};	880	delete $input->{refocus_map};
836	$MAPWIDGET->focus_in	881	$MAPWIDGET->focus_in
837	}	882	}
838	},	883	},
839	connect_escape => sub {	884	on_escape => sub {
840	$MAPWIDGET->focus_in	885	$MAPWIDGET->focus_in
841	},	886	},
842	);	887	);
843		888
844	$CONSOLE = {	889	$CONSOLE = {
845	window => $window,	890	window => $window,
846	input => $input	891	input => $input,
847	};	892	};
848		893
849	$window	894	$window
850	}	895	}
851		896
852	sub open_quit_dialog {	897	sub open_quit_dialog {
853	unless ($QUIT_DIALOG) {	898	unless ($QUIT_DIALOG) {
854
855	$QUIT_DIALOG = new CFClient::UI::FancyFrame title => "Really Quit?";	899	$QUIT_DIALOG = new CFClient::UI::FancyFrame
		900	x => "center",
		901	y => "center",
		902	title => "Really Quit?",
		903	;
856		904
857	$QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);	905	$QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);
858		906
859	$vb->add (new CFClient::UI::Label	907	$vb->add (new CFClient::UI::Label
860	text => "You should find a savebed and apply it first!",	908	text => "You should find a savebed and apply it first!",
…		…
863	);	911	);
864	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);	912	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
865	$hb->add (new CFClient::UI::Button	913	$hb->add (new CFClient::UI::Button
866	text => "Ok",	914	text => "Ok",
867	expand => 1,	915	expand => 1,
868	connect_activate => sub { $QUIT_DIALOG->hide },	916	on_activate => sub { $QUIT_DIALOG->hide },
869	);	917	);
870	$hb->add (new CFClient::UI::Button	918	$hb->add (new CFClient::UI::Button
871	text => "Quit anyway",	919	text => "Quit anyway",
872	expand => 1,	920	expand => 1,
873	connect_activate => sub { exit },	921	on_activate => sub { exit },
874	);	922	);
		923	}
875		924
876	$QUIT_DIALOG->show_centered;	925	$QUIT_DIALOG->show;
877	} else {
878	$QUIT_DIALOG->show_centered;
879	}
880	}	926	}
881		927
882	sub make_inventory_window {	928	sub make_inventory_window {
883	my $invwin = new CFClient::UI::FancyFrame	929	my $invwin = $INV_WINDOW = new CFClient::UI::FancyFrame
884	user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Inventory";	930	x => "center",
		931	y => "center",
		932	force_w => $WIDTH * 9/10,
		933	force_h => $HEIGHT * 9/10,
		934	title => "Inventory",
		935	name => "inventory_window",
		936	;
885		937
886	$invwin->add (my $hb = new CFClient::UI::HBox expand => 1);	938	$invwin->add (my $hb = new CFClient::UI::HBox homogeneous => 1);
887		939
888	$hb->add (my $vb1 = new CFClient::UI::VBox expand => 1);	940	$hb->add (my $vb1 = new CFClient::UI::VBox);
889	$vb1->add (my $lbl = new CFClient::UI::Label xalign => 0.5);	941	$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);	942	$vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
892		943
893	$hb->add (my $vb2 = new CFClient::UI::VBox expand => 1);	944	$hb->add (my $vb2 = new CFClient::UI::VBox);
		945
894	$vb2->add ($INVR_LBL = new CFClient::UI::Label xalign => 0.5);	946	$vb2->add ($INV_RIGHT_HB = new CFClient::UI::HBox);
895	$INVR_LBL->set_text ("Floor");	947
896	$vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);	948	$vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);
897		949
		950	# XXX: Call after $INVR = ... because set_opencont sets the items
		951	CFClient::Protocol::set_opencont ($::CONN, 0, "Floor");
		952
898	$invwin	953	$invwin
		954	}
		955
		956	sub make_binding_window {
		957	my $binding_list = new CFClient::UI::VBox;
		958
		959	my $refresh;
		960	$refresh = sub {
		961	$binding_list->clear ();
		962
		963	for my $mod (keys %{$::CFG->{bindings}}) {
		964	for my $sym (keys %{$::CFG->{bindings}->{$mod}}) {
		965	my $cmds = $::CFG->{bindings}->{$mod}->{$sym};
		966	next unless ref $cmds eq 'ARRAY' and @$cmds > 0;
		967
		968	my $lbl = join "; ", @$cmds;
		969	my $nam = CFClient::Binder::keycombo_to_name ($mod, $sym);
		970	$binding_list->add (my $hb = new CFClient::UI::HBox);
		971	$hb->add (new CFClient::UI::Button
		972	text => "delete",
		973	tooltip => "Deletes the binding",
		974	on_activate => sub {
		975	$binding_list->remove ($hb);
		976	delete $::CFG->{bindings}->{$mod}->{$sym};
		977	});
		978
		979	$hb->add (new CFClient::UI::Button
		980	text => "edit",
		981	tooltip => "Edits the binding",
		982	on_activate => sub {
		983	$::BIND_EDITOR->set_binding (
		984	$mod, $sym, $::CFG->{bindings}->{$mod}->{$sym},
		985	sub {
		986	my ($nmod, $nsym, $ncmds) = @_;
		987	delete $::CFG->{bindings}->{$mod}->{$sym};
		988	$::CFG->{bindings}->{$nmod}->{$nsym} = $ncmds;
		989	$refresh->();
		990	$::BIND_WINDOW->show;
		991	},
		992	sub {
		993	$::BIND_WINDOW->show;
		994	});
		995	$::BIND_EDITOR->show;
		996	$::BIND_WINDOW->hide;
		997	});
		998
		999	$hb->add (new CFClient::UI::Label text => "(Key: $nam)");
		1000	$hb->add (new CFClient::UI::Label text => $lbl, expand => 1);
		1001	}
		1002	}
		1003	};
		1004
		1005	$BIND_WINDOW = new CFClient::UI::FancyFrame
		1006	title => "Bindings",
		1007	x => "center",
		1008	y => "center",
		1009	def_w => int $WIDTH * 9/10,
		1010	def_h => int $HEIGHT * 9/10,
		1011	on_visibility_change => sub {
		1012	my ($self, $visible) = @_;
		1013	$refresh->() if $visible;
		1014	};
		1015
		1016	$BIND_WINDOW->add (my $vb = new CFClient::UI::VBox);
		1017	$vb->add ($binding_list);
		1018	$vb->add (my $hb = new CFClient::UI::HBox);
		1019	$hb->add (new CFClient::UI::Button
		1020	text => "record new",
		1021	expand => 1,
		1022	tooltip => "This button opens the binding editor with an empty binding.",
		1023	on_activate => sub {
		1024	$::BIND_EDITOR->set_binding (undef, undef, [],
		1025	sub {
		1026	my ($mod, $sym, $cmds) = @_;
		1027	$::CFG->{bindings}->{$mod}->{$sym} = $cmds;
		1028	$refresh->();
		1029	$::BIND_WINDOW->show;
		1030	},
		1031	sub {
		1032	$::BIND_WINDOW->show;
		1033	});
		1034	$::BIND_WINDOW->hide;
		1035	$::BIND_EDITOR->show;
		1036	},
		1037	);
		1038	$hb->add (new CFClient::UI::Button
		1039	text => "close",
		1040	tooltip => "Closes the binding window",
		1041	expand => 1,
		1042	on_activate => sub {
		1043	$::BIND_WINDOW->hide;
		1044	}
		1045	);
		1046
		1047	$refresh->();
		1048	$BIND_WINDOW
899	}	1049	}
900		1050
901	sub make_help_window {	1051	sub make_help_window {
902	my $win = new CFClient::UI::FancyFrame	1052	my $win = new CFClient::UI::FancyFrame
903	user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Documentation";	1053	def_w => int $WIDTH * 7/8,
		1054	def_h => int $HEIGHT * 7/8,
		1055	title => "Documentation";
904		1056
905	$win->add (my $vbox = new CFClient::UI::VBox);	1057	$win->add (my $vbox = new CFClient::UI::VBox);
906		1058
907	$vbox->add (my $buttons = new CFClient::UI::HBox);	1059	$vbox->add (my $buttons = new CFClient::UI::HBox);
908	$vbox->add (my $viewer = new CFClient::UI::TextView expand => 1, fontsize => 0.8);	1060	$vbox->add (my $viewer = new CFClient::UI::TextView expand => 1, fontsize => 0.8);
…		…
915	) {	1067	) {
916	my ($pod, $label) = @$_;	1068	my ($pod, $label) = @$_;
917		1069
918	$buttons->add (new CFClient::UI::Button	1070	$buttons->add (new CFClient::UI::Button
919	text => $label,	1071	text => $label,
920	connect_activate => sub {	1072	on_activate => sub {
921	my $parser = new Pod::POM;	1073	my $parser = new Pod::POM;
922	my $pom = $parser->parse_file (CFClient::find_rcfile "pod/$pod.pod");	1074	my $pom = $parser->parse_file (CFClient::find_rcfile "pod/$pod.pod");
923		1075
924	$viewer->clear;	1076	$viewer->clear;
925		1077
…		…
956	or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";	1108	or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";
957		1109
958	$SDL_ACTIVE = 1;	1110	$SDL_ACTIVE = 1;
959	$LAST_REFRESH = time - 0.01;	1111	$LAST_REFRESH = time - 0.01;
960		1112
961	CFClient::gl_init;	1113	CFClient::OpenGL::init;
962		1114
963	$FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};	1115	$FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
964		1116
965	$CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#	1117	$CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
966		1118
…		…
969	if ($DEBUG_STATUS) {	1121	if ($DEBUG_STATUS) {
970	CFClient::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;	1122	CFClient::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
971	} else {	1123	} else {
972	# create the widgets	1124	# create the widgets
973		1125
974	$DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100, req_x => -1;	1126	$DEBUG_STATUS = new CFClient::UI::Label
		1127	padding => 0,
		1128	z => 100,
		1129	force_x => "max",
		1130	force_y => 0;
975	$DEBUG_STATUS->show;	1131	$DEBUG_STATUS->show;
976		1132
		1133	$BIND_EDITOR = new CFClient::UI::BindEditor (x => "max", y => 0);
		1134
977	$STATUSBOX = new CFClient::UI::Statusbox;	1135	$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]);	1136	$STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", pri => -100, color => [1, 1, 1, 0.8]);
979		1137
980	(new CFClient::UI::Frame	1138	(new CFClient::UI::Frame
981	bg => [0, 0, 0, 0.4],	1139	bg => [0, 0, 0, 0.4],
982	req_y => -1,	1140	force_x => 0,
		1141	force_y => "max",
983	child => $STATUSBOX,	1142	child => $STATUSBOX,
984	)->show;	1143	)->show;
985		1144
986	CFClient::UI::FancyFrame->new (	1145	CFClient::UI::FancyFrame->new (
		1146	x => 0,
		1147	y => $FONTSIZE + 8,
987	border_bg => [1, 1, 1, 192/255],	1148	border_bg => [1, 1, 1, 192/255],
988	bg => [1, 1, 1, 0],	1149	bg => [1, 1, 1, 0],
989	child => ($MAPMAP = new CFClient::MapWidget::MapMap	1150	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.",	1151	tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
991	),	1152	),
…		…
1014	can_hover => 1,	1175	can_hover => 1,
1015	can_events => 1,	1176	can_events => 1,
1016	tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",	1177	tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",
1017	;	1178	;
1018		1179
1019	$BUTTONBAR = new CFClient::UI::HBox;	1180	$BUTTONBAR = new CFClient::UI::HBox x => 0, y => 0;
1020		1181
1021	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup,	1182	$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.");	1183	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,	1184	$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.");	1185	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 :).");	1194	tooltip => "Toggles the inventory window, where you can manage your loot (or treaures :).");
1034		1195
1035	$BUTTONBAR->add (new CFClient::UI::Button	1196	$BUTTONBAR->add (new CFClient::UI::Button
1036	text => "Save Config",	1197	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.",	1198	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 {	1199	on_activate => sub {
		1200	$::CFG->{layout} = CFClient::UI::get_layout;
1039	CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";	1201	CFClient::write_cfg "$Crossfire::VARDIR/cfplusrc";
1040	status "Configuration Saved";	1202	status "Configuration Saved";
1041	},	1203	},
1042	);	1204	);
1043		1205
1044	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => make_help_window,	1206	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => make_help_window,
1045	tooltip => "View Documentation");	1207	tooltip => "View Documentation");
1046		1208
		1209	$BUTTONBAR->add (new CFClient::UI::Flopper
		1210	text => "Bindings",
		1211	other => make_binding_window,
		1212	tooltip =>
		1213	"Lets you define, edit and delete bindings."
		1214	."There is a shortcut for making bindings: LCTRL+Insert opens the binding editor "
		1215	."with nothing set and the recording started. After doing the actions you "
		1216	."want to record press Insert and you will be asked to press a key-combo."
		1217	."After pressing the combo the binding will be saved automatically and the "
		1218	."binding editor closes"
		1219	);
		1220
1047	$BUTTONBAR->add (new CFClient::UI::Button	1221	$BUTTONBAR->add (new CFClient::UI::Button
1048	text => "Quit",	1222	text => "Quit",
1049	tooltip => "Terminates the program",	1223	tooltip => "Terminates the program",
1050	connect_activate => sub {	1224	on_activate => sub {
1051	if ($CONN) {	1225	if ($CONN) {
1052	open_quit_dialog;	1226	open_quit_dialog;
1053	} else {	1227	} else {
1054	exit;	1228	exit;
1055	}	1229	}
1056	},	1230	},
1057	);	1231	);
1058		1232
1059	$BUTTONBAR->show;	1233	$BUTTONBAR->show;
		1234	$SERVER_SETUP->show;
1060		1235
1061	$STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);	1236	$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	}	1237	}
1071	}	1238	}
1072		1239
1073	sub video_shutdown {	1240	sub video_shutdown {
1074	undef $SDL_ACTIVE;	1241	undef $SDL_ACTIVE;
…		…
1142		1309
1143	my %demo;#d#	1310	my %demo;#d#
1144		1311
1145	sub force_refresh {	1312	sub force_refresh {
1146	$fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;	1313	$fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
1147	debug sprintf "%3.2f", $fps;	1314	debug sprintf "%3.2f", $fps if $ENV{CFPLUS_DEBUG} & 4;
1148		1315
1149	$CFClient::UI::ROOT->draw;	1316	$CFClient::UI::ROOT->draw;
1150		1317
1151	$WANT_REFRESH = 0;	1318	$WANT_REFRESH = 0;
1152	$CAN_REFRESH = 0;	1319	$CAN_REFRESH = 0;
…		…
1235	sub animation_stop {	1402	sub animation_stop {
1236	my ($widget) = @_;	1403	my ($widget) = @_;
1237	delete $animate_object{$widget};	1404	delete $animate_object{$widget};
1238	}	1405	}
1239		1406
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	1407	# check once/second for faces that need to be prefetched
1735	# this should, of course, only run on demand, but	1408	# this should, of course, only run on demand, but
1736	# SDL forces worse things on us....	1409	# SDL forces worse things on us....
1737		1410
1738	Event->timer (after => 1, interval => 0.25, cb => sub {	1411	Event->timer (after => 1, interval => 0.25, cb => sub {
1739	$CONN->face_prefetch	1412	$CONN->face_prefetch
1740	if $CONN;	1413	if $CONN;
1741	});	1414	});
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		1415
1860	%SDL_CB = (	1416	%SDL_CB = (
1861	CFClient::SDL_QUIT => sub {	1417	CFClient::SDL_QUIT => sub {
1862	Event::unloop -1;	1418	Event::unloop -1;
1863	},	1419	},
…		…
1895	#############################################################################	1451	#############################################################################
1896		1452
1897	$SIG{INT} = $SIG{TERM} = sub { exit };	1453	$SIG{INT} = $SIG{TERM} = sub { exit };
1898		1454
1899	{	1455	{
1900	local $SIG{__DIE__} = sub { CFClient::fatal $_[0] };	1456	local $SIG{__DIE__} = sub { CFClient::fatal $_[0] if defined $^S && !$^S };
1901		1457
1902	CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";	1458	CFClient::read_cfg "$Crossfire::VARDIR/cfplusrc";
1903		1459	CFClient::UI::set_layout ($::CFG->{layout});
1904	$TILECACHE = CFClient::db_table "tilecache";
1905	$FACEMAP = CFClient::db_table "facemap";
1906		1460
1907	my %DEF_CFG = (	1461	my %DEF_CFG = (
1908	sdl_mode => 0,	1462	sdl_mode => 0,
1909	width => 640,	1463	width => 640,
1910	height => 480,	1464	height => 480,
…		…
1987		1541
1988	END { CFClient::SDL_Quit }	1542	END { CFClient::SDL_Quit }
1989		1543
1990	=head1 NAME	1544	=head1 NAME
1991		1545
1992	pclient - A Crossfire+ and Crossfire game client	1546	cfplus - A Crossfire+ and Crossfire game client
1993		1547
1994	=head1 SYNOPSIS	1548	=head1 SYNOPSIS
1995		1549
1996	Just run it - no commandline arguments are supported.	1550	Just run it - no commandline arguments are supported.
1997		1551
1998	=head1 USAGE	1552	=head1 USAGE
1999		1553
2000	Pclient utilises OpenGL for all UI elements and the game. It is supposed to be used	1554	cfplus utilises OpenGL for all UI elements and the game. It is supposed to be used
2001	fullscreen and interactively.	1555	fullscreen and interactively.
2002		1556
2003	=head1 AUTHOR	1557	=head1 AUTHOR
2004		1558
2005	Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>	1559	Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>

Diff Legend

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