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

Diff Legend

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