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

Diff Legend

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