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.1 by root, Thu May 25 16:24:45 2006 UTC vs.
Revision 1.85 by elmex, Sun Jul 2 19:32:56 2006 UTC

…		…
25	# need to do it again because that pile of garbage called PAR nukes it before main	25	# need to do it again because that pile of garbage called PAR nukes it before main
26	unshift @INC, $ENV{PAR_TEMP}	26	unshift @INC, $ENV{PAR_TEMP}
27	if %PAR::LibCache;	27	if %PAR::LibCache;
28		28
29	use Time::HiRes 'time';	29	use Time::HiRes 'time';
30	use Pod::POM;
31	use Event;	30	use Event;
32		31
33	use Crossfire;	32	use Crossfire;
34	use Crossfire::Protocol;	33	use Crossfire::Protocol::Constants;
35		34
36	use Compress::LZF;	35	use Compress::LZF;
37		36
38	use CFClient;	37	use CFClient;
		38	use CFClient::OpenGL ();
		39	use CFClient::Protocol;
39	use CFClient::UI;	40	use CFClient::UI;
		41	use CFClient::BindingEditor;
40	use CFClient::MapWidget;	42	use CFClient::MapWidget;
		43
		44	$SIG{QUIT} = sub { Carp::cluck "QUIT" };
41		45
42	$Event::DIED = sub {	46	$Event::DIED = sub {
43	# TODO: display dialog box or so	47	# TODO: display dialog box or so
		48	Carp::confess $_[1];#d#TODO: remove when stable
44	CFClient::error $_[1];	49	CFClient::error $_[1];
45	};	50	};
46		51
47	#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#	52	#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#
48		53
…		…
50		55
51	my $MAX_FPS = 60;	56	my $MAX_FPS = 60;
52	my $MIN_FPS = 5; # unused as of yet	57	my $MIN_FPS = 5; # unused as of yet
53		58
54	our $META_SERVER = "crossfire.real-time.com:13326";	59	our $META_SERVER = "crossfire.real-time.com:13326";
55
56	our $FACEMAP;
57	our $TILECACHE;
58	our $MAPCACHE;
59		60
60	our $LAST_REFRESH;	61	our $LAST_REFRESH;
61	our $NOW;	62	our $NOW;
62		63
63	our $CFG;	64	our $CFG;
…		…
83	our $LOGVIEW;	84	our $LOGVIEW;
84	our $CONSOLE;	85	our $CONSOLE;
85	our $METASERVER;	86	our $METASERVER;
86	our $LOGIN_BUTTON;	87	our $LOGIN_BUTTON;
87	our $QUIT_DIALOG;	88	our $QUIT_DIALOG;
		89	our $HOST_ENTRY;
		90	our $SERVER_INFO;
88		91
		92	our $SETUP_DIALOG;
		93	our $SETUP_NOTEBOOK;
		94	our $SETUP_SERVER;
		95	our $SETUP_KEYBOARD;
		96	our $SETUP_SPELLS;
		97
		98	our $STATS_WINDOW;
		99	our $MESSAGE_WINDOW;
89	our $FLOORBOX;	100	our $FLOORBOX;
90	our $GAUGES;	101	our $GAUGES;
91	our $STATWIDS;	102	our $STATWIDS;
92		103
93	our $SDL_ACTIVE;	104	our $SDL_ACTIVE;
…		…
99		110
100	our $ALT_ENTER_MESSAGE;	111	our $ALT_ENTER_MESSAGE;
101	our $STATUSBOX;	112	our $STATUSBOX;
102	our $DEBUG_STATUS;	113	our $DEBUG_STATUS;
103		114
104	our $INVWIN;
105	our $INV;	115	our $INV;
106	our $INVR;	116	our $INVR;
107	our $INVR_LBL;	117	our $INV_RIGHT_HB;
108	our $OPENCONT;	118
		119	our $PL_NOTEBOOK;
		120	our $PL_WINDOW;
		121
		122	our $BIND_EDITOR;
		123	our $BIND_UPD_CB;
		124
		125	our $PICKUP_CFG;
109		126
110	sub status {	127	sub status {
111	$STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);	128	$STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
112	}	129	}
113		130
114	sub debug {	131	sub debug {
115	$DEBUG_STATUS->set_text ($_[0]);	132	$DEBUG_STATUS->set_text ($_[0]);
116	my ($w, $h) = $DEBUG_STATUS->size_request;	133	}
117	$DEBUG_STATUS->move ($WIDTH - $w, 0);	134
		135	sub destroy_query_dialog {
		136	(delete $_[0]{query_dialog})->destroy
		137	if $_[0]{query_dialog};
		138	}
		139
		140	# server query dialog
		141	sub server_query {
		142	my ($conn, $flags, $prompt) = @_;
		143
		144	$conn->{query_dialog} = my $dialog = new CFClient::UI::FancyFrame
		145	x => "center",
		146	y => "center",
		147	title => "Server Query",
		148	child => my $vbox = new CFClient::UI::VBox,
		149	;
		150
		151	my @dialog = my $label = new CFClient::UI::Label
		152	max_w => $::WIDTH * 0.4,
		153	ellipsise => 0,
		154	text => $prompt;
		155
		156	if ($flags & CS_QUERY_YESNO) {
		157	push @dialog, my $hbox = new CFClient::UI::HBox;
		158
		159	$hbox->add (new CFClient::UI::Button
		160	text => "No",
		161	on_activate => sub {
		162	$conn->send ("reply n");
		163	$dialog->destroy;
		164	0
		165	}
		166	);
		167	$hbox->add (new CFClient::UI::Button
		168	text => "Yes",
		169	on_activate => sub {
		170	$conn->send ("reply y");
		171	destroy_query_dialog $conn;
		172	0
		173	},
		174	);
		175
		176	$dialog->grab_focus;
		177
		178	} elsif ($flags & CS_QUERY_SINGLECHAR) {
		179	$dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";
		180
		181	if ($prompt =~ /Now choose a character|Press any key for the next race/i) {
		182	$MESSAGE_WINDOW->show;
		183
		184	unshift @dialog, new CFClient::UI::Label
		185	max_w => $::WIDTH * 0.4,
		186	ellipsise => 0,
		187	markup => "\nOr use your keyboard:\n";
		188
		189	unshift @dialog, my $table = new CFClient::UI::Table;
		190
		191	$table->add (0, 0, new CFClient::UI::Button
		192	text => "Next Race",
		193	on_activate => sub {
		194	$conn->send ("reply n");
		195	destroy_query_dialog $conn;
		196	0
		197	},
		198	);
		199	$table->add (2, 0, new CFClient::UI::Button
		200	text => "Accept",
		201	on_activate => sub {
		202	$conn->send ("reply d");
		203	destroy_query_dialog $conn;
		204	0
		205	},
		206	);
		207
		208	unshift @dialog, new CFClient::UI::Label
		209	max_w => $::WIDTH * 0.4,
		210	ellipsise => 0,
		211	markup =>
		212	"<big><b>Character Creation: Race</b></big>\n\n"
		213	. "Look at the <b>Messages</b> window to see a description of this race "
		214	. "(<small>or hover with your mouse over the bottommost entry in the status area in the lower left area of the screen</small>) "
		215	. "and the center of the screen to see how this race looks like "
		216	. "(<small>this is below this dialog window, you may need to click on the display area to make it visible</small>).\n\n"
		217	. "You can look at another race, or accept this race (you will come back to this race eventually, "
		218	. "so you can take your time making this important choice."
		219	;
		220
		221	} elsif ($prompt =~ /roll new stats/) {
		222	if (my $stat = delete $conn->{stat_change_with}) {
		223	$conn->send ("reply $stat");
		224	destroy_query_dialog $conn;
		225	return;
		226	}
		227
		228	$STATS_WINDOW->show;
		229	$MESSAGE_WINDOW->hide;
		230
		231	unshift @dialog, new CFClient::UI::Label
		232	max_w => $::WIDTH * 0.4,
		233	ellipsise => 0,
		234	markup => "\nOr use your keyboard:\n";
		235
		236	unshift @dialog, my $table = new CFClient::UI::Table;
		237
		238	# left: re-roll
		239	$table->add (0, 0, new CFClient::UI::Button
		240	text => "Roll Again",
		241	on_activate => sub {
		242	$conn->send ("reply y");
		243	destroy_query_dialog $conn;
		244	0
		245	},
		246	);
		247
		248	# center: swap stats
		249	my ($sw1, $sw2) = map +(new CFClient::UI::Combobox
		250	value => $_,
		251	options => [
		252	[1 => "Str", "Strength ($conn->{stat}{+CS_STAT_STR})"],
		253	[2 => "Dex", "Dexterity ($conn->{stat}{+CS_STAT_DEX})"],
		254	[3 => "Con", "Constitution ($conn->{stat}{+CS_STAT_CON})"],
		255	[4 => "Int", "Intelligence ($conn->{stat}{+CS_STAT_INT})"],
		256	[5 => "Wis", "Wisdom ($conn->{stat}{+CS_STAT_WIS})"],
		257	[6 => "Pow", "Power ($conn->{stat}{+CS_STAT_POW})"],
		258	[7 => "Cha", "Charisma ($conn->{stat}{+CS_STAT_CHA})"],
		259	],
		260	), 1 .. 2;
		261
		262	$table->add (2, 0, new CFClient::UI::Button
		263	text => "Swap Stats",
		264	on_activate => sub {
		265	$conn->{stat_change_with} = $sw2->{value};
		266	$conn->send ("reply $sw1->{value}");
		267	destroy_query_dialog $conn;
		268	0
		269	},
		270	);
		271	$table->add (2, 1, new CFClient::UI::HBox children => [$sw1, $sw2]);
		272
		273	# right: accept
		274	$table->add (4, 0, new CFClient::UI::Button
		275	text => "Accept",
		276	on_activate => sub {
		277	$conn->send ("reply n");
		278	$STATS_WINDOW->hide;
		279	destroy_query_dialog $conn;
		280	0
		281	},
		282	);
		283
		284	unshift @dialog, new CFClient::UI::Label
		285	max_w => $::WIDTH * 0.4,
		286	ellipsise => 0,
		287	markup =>
		288	"<big><b>Character Creation: Stats</b></big>\n\n"
		289	. "Look at the <b>Stats</b> window to see your basic stats "
		290	. "(first column: 1 strength, 2 dexterity, 3 constitution, 4 intelligence, 5 wisdom, 6 power and 7 charisma).\n\n"
		291	. "You can create another set of stats, swap two stat values with each other or accept the stats as they are now and continue. "
		292	. "Race selection will influence those values later on."
		293	;
		294	}
		295
		296	push @dialog, my $entry = new CFClient::UI::Entry
		297	on_changed => sub {
		298	$conn->send ("reply $_[1]");
		299	destroy_query_dialog $conn;
		300	0
		301	},
		302	;
		303
		304	$entry->grab_focus;
		305
		306	} else {
		307	$dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
		308
		309	push @dialog, my $entry = new CFClient::UI::Entry
		310	$flags & CS_QUERY_HIDEINPUT ? (hidden => "*") : (),
		311	on_activate => sub {
		312	$conn->send ("reply $_[1]");
		313	destroy_query_dialog $conn;
		314	0
		315	},
		316	;
		317
		318	$entry->grab_focus;
		319	}
		320
		321	$vbox->add (@dialog);
		322	$dialog->show;
118	}	323	}
119		324
120	sub start_game {	325	sub start_game {
121	status "logging in...";	326	status "logging in...";
122		327
		328	$LOGIN_BUTTON->set_text ("Logout");
		329	$SETUP_DIALOG->hide;
		330
123	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;	331	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
124		332
125	$MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";	333	my ($host, $port) = split /:/, $CFG->{profile}{default}{host};
		334
126	$MAP = new CFClient::Map $mapsize, $mapsize;	335	$MAP = new CFClient::Map $mapsize, $mapsize;
127
128	my ($host, $port) = split /:/, $CFG->{host};
129		336
130	$CONN = eval {	337	$CONN = eval {
131	new conn	338	new CFClient::Protocol
132	host => $host,	339	host => $host,
133	port => $port || 13327,	340	port => $port || 13327,
134	user => $CFG->{user},	341	user => $CFG->{profile}{default}{user},
135	pass => $CFG->{password},	342	pass => $CFG->{profile}{default}{password},
136	mapw => $mapsize,	343	mapw => $mapsize,
137	maph => $mapsize,	344	maph => $mapsize,
138	;	345
		346	map_widget => $MAPWIDGET,
		347	logview => $LOGVIEW,
		348	statusbox => $STATUSBOX,
		349	map => $MAP,
		350	mapmap => $MAPMAP,
		351	query => \&server_query,
		352
		353	sound_play => sub {
		354	my ($x, $y, $soundnum, $type) = @_;
		355
		356	$SDL_MIXER
		357	or return;
		358
		359	my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
		360	or return;
		361
		362	$chunk->play;
		363	},
139	};	364	};
140		365
141	if ($CONN) {	366	if ($CONN) {
142	CFClient::lowdelay fileno $CONN->{fh};	367	CFClient::lowdelay fileno $CONN->{fh};
143		368
144	$LOGIN_BUTTON->set_text ("Logout");
145	status "login successful";	369	status "login successful";
146
147	$BUTTONBAR->{children}[1]->emit ("activate")
148	if $BUTTONBAR->{children}[1]->{state};
149
150	} else {	370	} else {
151	status "unable to connect";	371	status "unable to connect";
152	stop_game();	372	stop_game();
153	}	373	}
154	}	374	}
155		375
156	sub stop_game {	376	sub stop_game {
		377	$LOGIN_BUTTON->set_text ("Login");
		378	$SETUP_NOTEBOOK->set_current_page ($SETUP_SERVER);
		379	$SETUP_DIALOG->show;
		380	$PL_WINDOW->hide;
		381	$SETUP_SPELLS->clear_spells;
		382
157	return unless $CONN;	383	return unless $CONN;
158		384
159	status "connection closed";	385	status "connection closed";
160	$LOGIN_BUTTON->set_text ("Login");	386
		387	destroy_query_dialog $CONN;
161	$CONN->destroy;	388	$CONN->destroy;
162	$CONN = 0; # false, does not autovivify	389	$CONN = 0; # false, does not autovivify
163		390
164	$BUTTONBAR->{children}[1]->emit ("activate")
165	unless $BUTTONBAR->{children}[1]->{state};
166
167	undef $MAPCACHE;
168	undef $MAP;	391	undef $MAP;
169	}	392	}
170		393
171	sub client_setup {	394	sub graphics_setup {
172	my $dialog = new CFClient::UI::FancyFrame
173	title => "Client Setup",
174	child => (my $vbox = new CFClient::UI::VBox);	395	my $vbox = new CFClient::UI::VBox;
		396
175	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);	397	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
176		398
177	$table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");	399	$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);	400	$table->add (1, 0, my $hbox = new CFClient::UI::HBox);
179		401
180	$hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1]);	402	$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");	403	$hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");
182		404
183	$mode_slider->connect (changed => sub {	405	$mode_slider->connect (changed => sub {
184	my ($self, $value) = @_;	406	my ($self, $value) = @_;
185		407
…		…
192		414
193	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");	415	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
194	$table->add (1, $row++, new CFClient::UI::CheckBox	416	$table->add (1, $row++, new CFClient::UI::CheckBox
195	state => $CFG->{fullscreen},	417	state => $CFG->{fullscreen},
196	tooltip => "Bring the client into fullscreen mode.",	418	tooltip => "Bring the client into fullscreen mode.",
197	connect_changed => sub {	419	on_changed => sub { my ($self, $value) = @_; $CFG->{fullscreen} = $value; 0 }
198	my ($self, $value) = @_;
199	$CFG->{fullscreen} = $value;
200	}
201	);	420	);
202		421
203	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");	422	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
204	$table->add (1, $row++, new CFClient::UI::CheckBox	423	$table->add (1, $row++, new CFClient::UI::CheckBox
205	state => $CFG->{fast},	424	state => $CFG->{fast},
206	tooltip => "Lower the visual quality considerably to speed up rendering.",	425	tooltip => "Lower the visual quality considerably to speed up rendering.",
207	connect_changed => sub {	426	on_changed => sub { my ($self, $value) = @_; $CFG->{fast} = $value; 0 }
208	my ($self, $value) = @_;
209	$CFG->{fast} = $value;
210	}
211	);	427	);
212		428
213	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");	429	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
214	$table->add (1, $row++, new CFClient::UI::Slider	430	$table->add (1, $row++, new CFClient::UI::Slider
215	range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],	431	range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
216	tooltip => "Enlarge or shrink the displayed map. Changes are instant.",	432	tooltip => "Enlarge or shrink the displayed map. Changes are instant.",
217	connect_changed => sub {	433	on_changed => sub { my ($self, $value) = @_; $CFG->{map_scale} = 2 ** $value; 0 }
218	my ($self, $value) = @_;
219	$CFG->{map_scale} = 2 ** $value;
220	}
221	);	434	);
222		435
223	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");	436	$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	437	$table->add (1, $row++, new CFClient::UI::CheckBox
225	state => $CFG->{fow_enable},	438	state => $CFG->{fow_enable},
226	tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",	439	tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",
227	connect_changed => sub {	440	on_changed => sub { my ($self, $value) = @_; $CFG->{fow_enable} = $value; 0 }
228	my ($self, $value) = @_;
229	$CFG->{fow_enable} = $value;
230	}
231	);	441	);
232		442
233	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");	443	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
234	$table->add (1, $row++, new CFClient::UI::Slider	444	$table->add (1, $row++, new CFClient::UI::Slider
235	range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],	445	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.",	446	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 {	447	on_changed => sub { my ($self, $value) = @_; $CFG->{fow_intensity} = $value; 0 }
238	my ($self, $value) = @_;
239	$CFG->{fow_intensity} = $value;
240	}
241	);	448	);
242		449
243	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");	450	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
244	$table->add (1, $row++, new CFClient::UI::CheckBox	451	$table->add (1, $row++, new CFClient::UI::CheckBox
245	state => $CFG->{fow_smooth},	452	state => $CFG->{fow_smooth},
246	tooltip => "Smooth the Fog-of-War a bit to make it more realistic. Changes are instant.",	453	tooltip => "Smooth the Fog-of-War a bit to make it more realistic. Changes are instant.",
247	connect_changed => sub {	454	on_changed => sub {
248	my ($self, $value) = @_;	455	my ($self, $value) = @_;
249	$CFG->{fow_smooth} = $value;	456	$CFG->{fow_smooth} = $value;
250	status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2;	457	status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::OpenGL::GL_VERSION < 1.2;
		458	0
251	}	459	}
252	);	460	);
253		461
254	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");	462	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
255	$table->add (1, $row++, new CFClient::UI::Slider	463	$table->add (1, $row++, new CFClient::UI::Slider
256	range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],	464	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.",	465	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] },	466	on_changed => sub { $CFG->{gui_fontsize} = $_[1]; 0 },
259	);	467	);
260		468
261	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Message Fontsize");	469	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Message Fontsize");
262	$table->add (1, $row++, new CFClient::UI::Slider	470	$table->add (1, $row++, new CFClient::UI::Slider
263	range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],	471	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.",	472	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]) },	473	on_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]); 0 },
266	);	474	);
267		475
268	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");	476	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
269		477
270	$table->add (1, $row++, new CFClient::UI::Slider	478	$table->add (1, $row++, new CFClient::UI::Slider
271	range => [$CFG->{stat_fontsize}, 0.5, 2, 0, 0.1],	479	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.",	480	tooltip => "The font size used by the <b>statistics window</b> only. Changes are instant.",
273	connect_changed => sub {	481	on_changed => sub {
274	$CFG->{stat_fontsize} = $_[1];	482	$CFG->{stat_fontsize} = $_[1];
275	&set_stats_window_fontsize;	483	&set_stats_window_fontsize;
		484	0
276	}	485	}
277	);	486	);
278		487
279	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");	488	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
280	$table->add (1, $row++, new CFClient::UI::Slider	489	$table->add (1, $row++, new CFClient::UI::Slider
281	range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],	490	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.",	491	tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.",
283	connect_changed => sub {	492	on_changed => sub {
284	$CFG->{gauge_fontsize} = $_[1];	493	$CFG->{gauge_fontsize} = $_[1];
285	&set_gauge_window_fontsize;	494	&set_gauge_window_fontsize;
		495	0
286	}	496	}
287	);	497	);
288		498
289	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");	499	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
290	$table->add (1, $row++, new CFClient::UI::Slider	500	$table->add (1, $row++, new CFClient::UI::Slider
291	range => [$CFG->{gauge_size}, 0.2, 0.8],	501	range => [$CFG->{gauge_size}, 0.2, 0.8],
292	tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",	502	tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",
293	connect_changed => sub {	503	on_changed => sub {
294	$CFG->{gauge_size} = $_[1];	504	$CFG->{gauge_size} = $_[1];
295	$GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});	505	$GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
		506	0
296	}	507	}
297	);	508	);
298		509
299	$table->add (1, $row++, new CFClient::UI::Button	510	$table->add (1, $row++, new CFClient::UI::Button
300	expand => 1, align => 0, text => "Apply",	511	expand => 1, align => 0, text => "Apply",
301	tooltip => "Apply the video settings",	512	tooltip => "Apply the video settings",
302	connect_activate => sub {	513	on_activate => sub {
303	video_shutdown ();	514	video_shutdown ();
304	video_init ();	515	video_init ();
		516	0
305	}	517	}
306	);	518	);
		519
		520	$vbox
		521	}
		522
		523	sub audio_setup {
		524	my $vbox = new CFClient::UI::VBox;
		525
		526	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
		527
		528	my $row = 0;
307		529
308	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");	530	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");
309	$table->add (1, $row++, new CFClient::UI::CheckBox	531	$table->add (1, $row++, new CFClient::UI::CheckBox
310	state => $CFG->{audio_enable},	532	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.",	533	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 {	534	on_changed => sub { $CFG->{audio_enable} = $_[1]; 0 }
313	$CFG->{audio_enable} = $_[1];
314	}
315	);	535	);
316	# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume");	536	# $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 {	537	# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], on_changed => sub {
318	# $CFG->{effects_volume} = $_[1];	538	# $CFG->{effects_volume} = $_[1];
319	# });	539	# });
320	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");	540	$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);	541	$table->add (1, $row++, my $hbox = new CFClient::UI::HBox);
322	$hbox->add (new CFClient::UI::CheckBox	542	$hbox->add (new CFClient::UI::CheckBox
323	expand => 1, state => $CFG->{bgm_enable},	543	expand => 1, state => $CFG->{bgm_enable},
324	tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",	544	tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",
325	connect_changed => sub {	545	on_changed => sub { $CFG->{bgm_enable} = $_[1]; 0 }
326	$CFG->{bgm_enable} = $_[1];
327	}
328	);	546	);
329	$hbox->add (new CFClient::UI::Slider	547	$hbox->add (new CFClient::UI::Slider
330	expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],	548	expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],
331	tooltip => "The volume of the background music. Changes are instant.",	549	tooltip => "The volume of the background music. Changes are instant.",
332	connect_changed => sub {	550	on_changed => sub { $CFG->{bgm_volume} = $_[1]; CFClient::MixMusic::volume $_[1] * 128; 0 }
333	$CFG->{bgm_volume} = $_[1];
334	CFClient::MixMusic::volume $_[1] * 128;
335	}
336	);	551	);
337		552
338	$table->add (1, $row++, new CFClient::UI::Button	553	$table->add (1, $row++, new CFClient::UI::Button
339	expand => 1, align => 0, text => "Apply",	554	expand => 1, align => 0, text => "Apply",
340	tooltip => "Apply the audio settings",	555	tooltip => "Apply the audio settings",
341	connect_activate => sub {	556	on_activate => sub {
342	audio_shutdown ();	557	audio_shutdown ();
343	audio_init ();	558	audio_init ();
		559	0
344	}	560	}
345	);	561	);
346		562
347	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Chat Command");	563	$vbox
348	$table->add (1, $row++, my $saycmd = new CFClient::UI::Entry
349	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. "
351	. "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.",
353	connect_changed => sub {
354	my ($self, $value) = @_;
355	$CFG->{say_command} = $value;
356	}
357	);
358
359	$dialog
360	}	564	}
361		565
362	sub set_stats_window_fontsize {	566	sub set_stats_window_fontsize {
363	for (values %{$STATWIDS}) {	567	for (values %{$STATWIDS}) {
364	$_->set_fontsize ($::CFG->{stat_fontsize});	568	$_->set_fontsize ($::CFG->{stat_fontsize});
…		…
373		577
374	sub make_gauge_window {	578	sub make_gauge_window {
375	my $gh = int $HEIGHT * $CFG->{gauge_size};	579	my $gh = int $HEIGHT * $CFG->{gauge_size};
376		580
377	my $win = new CFClient::UI::Frame (	581	my $win = new CFClient::UI::Frame (
378	req_y => -1,	582	force_x => 0,
		583	force_y => "max",
379	user_w => $WIDTH,	584	force_w => $WIDTH,
380	user_h => $gh,	585	force_h => $gh,
381	);	586	);
382		587
383	$win->add (my $hbox = new CFClient::UI::HBox	588	$win->add (my $hbox = new CFClient::UI::HBox
384	children => [	589	children => [
385	(new CFClient::UI::HBox expand => 1),	590	(new CFClient::UI::HBox expand => 1),
386	(new CFClient::UI::VBox children => [	591	(new CFClient::UI::VBox children => [
387	(new CFClient::UI::Empty expand => 1),	592	(new CFClient::UI::Empty expand => 1),
388	(new CFClient::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new CFClient::UI::VBox)),	593	(new CFClient::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new CFClient::UI::Table)),
389	]),	594	]),
390	(my $vbox = new CFClient::UI::VBox),	595	(my $vbox = new CFClient::UI::VBox),
391	],	596	],
392	);	597	);
393		598
…		…
421	&set_gauge_window_fontsize;	626	&set_gauge_window_fontsize;
422		627
423	$win	628	$win
424	}	629	}
425		630
		631	sub debug_setup {
		632	my $table = new CFClient::UI::Table;
		633
		634	$table->add (0, 0, new CFClient::UI::Label text => "Widget Borders");
		635	$table->add (1, 0, new CFClient::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 1; 0 });
		636	$table->add (0, 1, new CFClient::UI::Label text => "Tooltip Widget Info");
		637	$table->add (1, 1, new CFClient::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 2; 0 });
		638	$table->add (0, 2, new CFClient::UI::Label text => "Show FPS");
		639	$table->add (1, 2, new CFClient::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 4; 0 });
		640	$table->add (0, 3, new CFClient::UI::Label text => "Suppress Tooltips");
		641	$table->add (1, 3, new CFClient::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 8; 0 });
		642
		643	my @default_smooth = (0.05, 0.13, 0.05, 0.13, 0.30, 0.13, 0.05, 0.13, 0.05);
		644
		645	for my $x (0..2) {
		646	for my $y (0 .. 2) {
		647	$table->add ($x + 3, $y,
		648	new CFClient::UI::Entry
		649	text => $default_smooth[$x * 3 + $y],
		650	on_changed => sub { $MAP->{smooth_matrix}[$x * 3 + $y] = $_[1] if $MAP; 0 },
		651	);
		652	}
		653	}
		654
		655
		656	$table
		657	}
		658
426	sub make_stats_window {	659	sub stats_window {
427	my $tgw = new CFClient::UI::FancyFrame title => "Stats";	660	my $tgw =
		661	new CFClient::UI::Window
		662	child => my $vb = new CFClient::UI::VBox;
428		663
429	$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,	664	$vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,
431	can_hover => 1, can_events => 1,	665	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.");	666	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,	667	$vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,
434	can_hover => 1, can_events => 1,	668	can_hover => 1, can_events => 1,
435	tooltip => "The map you are currently on (if supported by the server).");	669	tooltip => "The map you are currently on (if supported by the server).");
		670
		671	$vb->add (my $hb0 = new CFClient::UI::HBox);
		672	$hb0->add ($STATWIDS->{weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1,
		673	can_hover => 1, can_events => 1,
		674	tooltip => "The weight of the player including all inventory items.");
		675	$hb0->add ($STATWIDS->{m_weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1,
		676	can_hover => 1, can_events => 1,
		677	tooltip => "The weight limit: you cannot carry more than this.");
		678
436		679
437	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);	680	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
438	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);	681	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);
439		682
440	my $color2 = [1, 1, 0];	683	my $color2 = [1, 1, 0];
…		…
449	[0, 6, st_cha => "Cha", 30, "<b>Charisma</b>, how well you are received by NPCs. Affects buying and selling prices in shops."],	692	[0, 6, st_cha => "Cha", 30, "<b>Charisma</b>, how well you are received by NPCs. Affects buying and selling prices in shops."],
450		693
451	[2, 0, st_wc => "Wc", -120, "<b>Weapon Class</b>, effectiveness of melee/missile attacks. Lower is more potent. Current weapon, level and Str are some things which effect the value of Wc. The value of Wc may range between 25 and -72."],	694	[2, 0, st_wc => "Wc", -120, "<b>Weapon Class</b>, effectiveness of melee/missile attacks. Lower is more potent. Current weapon, level and Str are some things which effect the value of Wc. The value of Wc may range between 25 and -72."],
452	[2, 1, st_ac => "Ac", -120, "<b>Armour Class</b>, how protected you are from being hit by any attack. Lower values are better. Ac is based on your race and is modified by the Dex and current armour worn. For characters that cannot wear armour, Ac improves as their level increases."],	695	[2, 1, st_ac => "Ac", -120, "<b>Armour Class</b>, how protected you are from being hit by any attack. Lower values are better. Ac is based on your race and is modified by the Dex and current armour worn. For characters that cannot wear armour, Ac improves as their level increases."],
453	[2, 2, st_dam => "Dam", 120, "<b>Damage</b>, how much damage your melee/missile attack inflicts. Higher values indicate a greater amount of damage will be inflicted with each attack."],	696	[2, 2, st_dam => "Dam", 120, "<b>Damage</b>, how much damage your melee/missile attack inflicts. Higher values indicate a greater amount of damage will be inflicted with each attack."],
454	[2, 3, st_arm => "Arm", 120, "<b>Armour</b>, how much damage (from physical attacks) will be subtracted from successful hits made upon you. This value ranges between 0 to 99%. Current armour worn primarily determines Arm value."],	697	[2, 3, st_arm => "Arm", 120, "<b>Armour</b>, how much damage (from physical attacks) will be subtracted from successful hits made upon you. This value ranges between 0 to 99%. Current armour worn primarily determines Arm value. This is the same as the physical resistance."],
455	[2, 4, st_spd => "Spd", 10.54, "<b>Speed</b>, how fast you can move. The value of speed may range between nearly 0 (\"very slow\") to higher than 5 (\"lightning fast\"). Base speed is determined from the Dex and modified downward proportionally by the amount of weight carried which exceeds the Max Carry limit. The armour worn also sets the upper limit on speed."],	698	[2, 4, st_spd => "Spd", 10.54, "<b>Speed</b>, how fast you can move. The value of speed may range between nearly 0 (\"very slow\") to higher than 5 (\"lightning fast\"). Base speed is determined from the Dex and modified downward proportionally by the amount of weight carried which exceeds the Max Carry limit. The armour worn also sets the upper limit on speed."],
456	[2, 5, st_wspd => "WSp", 10.54, "<b>Weapon Speed</b>, how many attacks you may make per unit of time (0.120s). Higher values indicate faster attack speed. Current weapon and Dex effect the value of weapon speed."],	699	[2, 5, st_wspd => "WSp", 10.54, "<b>Weapon Speed</b>, how many attacks you may make per unit of time (0.120s). Higher values indicate faster attack speed. Current weapon and Dex effect the value of weapon speed."],
457	) {	700	) {
458	my ($col, $row, $id, $label, $template, $tooltip) = @$_;	701	my ($col, $row, $id, $label, $template, $tooltip) = @$_;
459		702
…		…
478	drain => "<b>Draining</b> (some monsters (e.g. vampires) and other effects can steal experience)",	721	drain => "<b>Draining</b> (some monsters (e.g. vampires) and other effects can steal experience)",
479	acid => "<b>Acid</b> (resistance to acid, acid hurts pretty much and also corrodes your weapons)",	722	acid => "<b>Acid</b> (resistance to acid, acid hurts pretty much and also corrodes your weapons)",
480	pois => "<b>Poison</b> (resistance to getting poisoned)",	723	pois => "<b>Poison</b> (resistance to getting poisoned)",
481	para => "<b>Paralysation</b> (this resistance affects the chance you get paralysed)",	724	para => "<b>Paralysation</b> (this resistance affects the chance you get paralysed)",
482	deat => "<b>Death</b> (resistance against death spells)",	725	deat => "<b>Death</b> (resistance against death spells)",
483	phys => "<b>Physical</b> (this is the resistance against physical attacks, like when a monster hit you in melee combat)",	726	phys => "<b>Physical</b> (this is the resistance against physical attacks, like when a monster hit you in melee combat. The value displayed here is also displayed in the 'Arm' field on the left.)",
484	blind => "<b>Blind</b> (blind resistance affects the chance of a successful blinding attack)",	727	blind => "<b>Blind</b> (blind resistance affects the chance of a successful blinding attack)",
485	fear => "<b>Fear</b> (this attack will drive you away from monsters who cast this and hit you successfully, being resistant to this helps a lot when fighting those monsters)",	728	fear => "<b>Fear</b> (this attack will drive you away from monsters who cast this and hit you successfully, being resistant to this helps a lot when fighting those monsters)",
486	tund => "<b>Turn undead</b> (affects your resistancy to various forms of 'turn undead' spells. Only relevant when you are, in fact, undead...",	729	tund => "<b>Turn undead</b> (affects your resistancy to various forms of 'turn undead' spells. Only relevant when you are, in fact, undead...",
487	elec => "<b>Electricity</b> (resistance against electricity, spells like large lightning, small lightning, ...)",	730	elec => "<b>Electricity</b> (resistance against electricity, spells like large lightning, small lightning, ...)",
488	cold => "<b>Cold</b> (this is your resistance against cold spells like icestorm, snowstorm, ...)",	731	cold => "<b>Cold</b> (this is your resistance against cold spells like icestorm, snowstorm, ...)",
…		…
505	);	748	);
506	$tbl2->add ($col + 1, $row, new CFClient::UI::Image	749	$tbl2->add ($col + 1, $row, new CFClient::UI::Image
507	font => $FONT_FIXED,	750	font => $FONT_FIXED,
508	can_hover => 1,	751	can_hover => 1,
509	can_events => 1,	752	can_events => 1,
510	image => "ui/resist/resist_$_.png",	753	path => "ui/resist/resist_$_.png",
511	tooltip => $resist_names{$_},	754	tooltip => $resist_names{$_},
512	);	755	);
513		756
514	$row++;	757	$row++;
515	if ($row % 6 == 0) {	758	if ($row % 6 == 0) {
…		…
522	update_stats_window ({});	765	update_stats_window ({});
523		766
524	$tgw	767	$tgw
525	}	768	}
526		769
527	sub formsep {	770	sub formsep($) {
528	reverse join ",", grep length, split /(...)/, reverse $_[0] * 1	771	scalar reverse join ",", unpack "(A3)*", reverse $_[0] * 1
529	}	772	}
530		773
531	sub update_stats_window {	774	sub update_stats_window {
532	my ($stats) = @_;	775	my ($stats) = @_;
533		776
534	# i love text protocols!!!	777	# I love text protocols...
		778
535	my $hp = $stats->{Crossfire::Protocol::CS_STAT_HP} * 1;	779	my $hp = $stats->{+CS_STAT_HP} * 1;
536	my $hp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXHP} * 1;	780	my $hp_m = $stats->{+CS_STAT_MAXHP} * 1;
537	my $sp = $stats->{Crossfire::Protocol::CS_STAT_SP} * 1;	781	my $sp = $stats->{+CS_STAT_SP} * 1;
538	my $sp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXSP} * 1;	782	my $sp_m = $stats->{+CS_STAT_MAXSP} * 1;
539	my $fo = $stats->{Crossfire::Protocol::CS_STAT_FOOD} * 1;	783	my $fo = $stats->{+CS_STAT_FOOD} * 1;
540	my $fo_m = 999;	784	my $fo_m = 999;
541	my $gr = $stats->{Crossfire::Protocol::CS_STAT_GRACE} * 1;	785	my $gr = $stats->{+CS_STAT_GRACE} * 1;
542	my $gr_m = $stats->{Crossfire::Protocol::CS_STAT_MAXGRACE} * 1;	786	my $gr_m = $stats->{+CS_STAT_MAXGRACE} * 1;
543		787
544	$GAUGES->{hp} ->set_value ($hp, $hp_m);	788	$GAUGES->{hp} ->set_value ($hp, $hp_m);
545	$GAUGES->{mana} ->set_value ($sp, $sp_m);	789	$GAUGES->{mana} ->set_value ($sp, $sp_m);
546	$GAUGES->{food} ->set_value ($fo, $fo_m);	790	$GAUGES->{food} ->set_value ($fo, $fo_m);
547	$GAUGES->{grace} ->set_value ($gr, $gr_m);	791	$GAUGES->{grace} ->set_value ($gr, $gr_m);
548	$GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::CS_STAT_EXP64})	792	$GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{+CS_STAT_EXP64})
549	. " (lvl " . ($stats->{Crossfire::Protocol::CS_STAT_LEVEL} * 1) . ")");	793	. " (lvl " . ($stats->{+CS_STAT_LEVEL} * 1) . ")");
550	my $rng = $stats->{Crossfire::Protocol::CS_STAT_RANGE};	794	my $rng = $stats->{+CS_STAT_RANGE};
551	$rng =~ s/^Range: //; # thank you so much dear server	795	$rng =~ s/^Range: //; # thank you so much dear server
552	$GAUGES->{range} ->set_text ("Rng: " . $rng);	796	$GAUGES->{range} ->set_text ("Rng: " . $rng);
553	my $title = $stats->{Crossfire::Protocol::CS_STAT_TITLE};	797	my $title = $stats->{+CS_STAT_TITLE};
554	$title =~ s/^Player: //;	798	$title =~ s/^Player: //;
555	$STATWIDS->{title} ->set_text ("Title: " . $title);	799	$STATWIDS->{title} ->set_text ("Title: " . $title);
556		800
557	$STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});	801	$STATWIDS->{st_str} ->set_text (sprintf "%d" , $stats->{+CS_STAT_STR});
558	$STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});	802	$STATWIDS->{st_dex} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DEX});
559	$STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9});	803	$STATWIDS->{st_con} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CON});
560	$STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6});	804	$STATWIDS->{st_int} ->set_text (sprintf "%d" , $stats->{+CS_STAT_INT});
561	$STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7});	805	$STATWIDS->{st_wis} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WIS});
562	$STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22});	806	$STATWIDS->{st_pow} ->set_text (sprintf "%d" , $stats->{+CS_STAT_POW});
563	$STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});	807	$STATWIDS->{st_cha} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CHA});
564	$STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13});	808	$STATWIDS->{st_wc} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WC});
565	$STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14});	809	$STATWIDS->{st_ac} ->set_text (sprintf "%d" , $stats->{+CS_STAT_AC});
566	$STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});	810	$STATWIDS->{st_dam} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DAM});
567	$STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});	811	$STATWIDS->{st_arm} ->set_text (sprintf "%d" , $stats->{+CS_STAT_RES_PHYS});
568	$STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_SPEED});	812	$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});	813	$STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{+CS_STAT_WEAP_SP});
		814
		815	$STATWIDS->{m_weight}->set_text (sprintf "Max weight: %.1fkg", $stats->{+CS_STAT_WEIGHT_LIM} / 1000);
570		816
571	my %tbl = (	817	my %tbl = (
572	phys => 100,	818	phys => CS_STAT_RES_PHYS,
573	magic => 101,	819	magic => CS_STAT_RES_MAG,
574	fire => 102,	820	fire => CS_STAT_RES_FIRE,
575	elec => 103,	821	elec => CS_STAT_RES_ELEC,
576	cold => 104,	822	cold => CS_STAT_RES_COLD,
577	conf => 105,	823	conf => CS_STAT_RES_CONF,
578	acid => 106,	824	acid => CS_STAT_RES_ACID,
579	drain => 107,	825	drain => CS_STAT_RES_DRAIN,
580	ghit => 108,	826	ghit => CS_STAT_RES_GHOSTHIT,
581	pois => 109,	827	pois => CS_STAT_RES_POISON,
582	slow => 110,	828	slow => CS_STAT_RES_SLOW,
583	para => 111,	829	para => CS_STAT_RES_PARA,
584	tund => 112,	830	tund => CS_STAT_TURN_UNDEAD,
585	fear => 113,	831	fear => CS_STAT_RES_FEAR,
586	depl => 113,	832	depl => CS_STAT_RES_DEPLETE,
587	deat => 115,	833	deat => CS_STAT_RES_DEATH,
588	holyw => 116,	834	holyw => CS_STAT_RES_HOLYWORD,
589	blind => 117	835	blind => CS_STAT_RES_BLIND,
590	);	836	);
591		837
592	for (keys %tbl) {
593	$STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}});	838	$STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}})
594	}	839	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	}	840	}
607		841
608	my $METASERVER_ATIME;	842	my $METASERVER_ATIME;
609		843
610	sub update_metaserver {	844	sub update_metaserver {
611	my ($HOST) = @_;	845	my ($metaserver_dialog) = @_;
		846
		847	$METASERVER = $metaserver_dialog
		848	if defined $metaserver_dialog;
612		849
613	return if $METASERVER_ATIME > time;	850	return if $METASERVER_ATIME > time;
614	$METASERVER_ATIME = time + 60;	851	$METASERVER_ATIME = time + 60;
615		852
616	my $table = $METASERVER->{table};	853	my $table = $METASERVER->{table};
…		…
638		875
639	utf8::decode $buf if utf8::valid $buf;	876	utf8::decode $buf if utf8::valid $buf;
640		877
641	$table->clear;	878	$table->clear;
642		879
		880	my @tip = (
		881	"The current number of users logged in on the server.",
		882	"The hostname of the server.",
		883	"The time this server has been running without being restarted.",
		884	"The server software version - a '+' indicates a Crossfire+ server.",
		885	"Short information about this server provided by its admins.",
		886	);
643	my @col = qw(Use #Users Host Uptime Version Description);	887	my @col = qw(#Users Host Uptime Version Description);
644	$table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])	888	$table->add ($_, 0, new CFClient::UI::Label
		889	can_hover => 1, can_events => 1,
		890	align => 0, fg => [1, 1, 0],
		891	text => $col[$_], tooltip => $tip[$_])
645	for 0 .. $#col;	892	for 0 .. $#col;
646		893
647	my @align = qw(1 0 1 1 -1);	894	my @align = qw(1 0 1 1 -1);
648		895
649	my $y = 0;	896	my $y = 0;
650	for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) {	897	for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) {
…		…
667		914
668	$m = [$users, $host, $uptime, $version, $desc];	915	$m = [$users, $host, $uptime, $version, $desc];
669		916
670	$y++;	917	$y++;
671		918
672	$table->add (0, $y, new CFClient::UI::VBox children => [	919	$table->add (scalar @$m, $y, new CFClient::UI::VBox children => [
673	(new CFClient::UI::Button text => "Use", connect_activate => sub {	920	(new CFClient::UI::Button
		921	text => "Use",
		922	tooltip => "Put this server into the <b>Host:Port</b> field",
		923	on_activate => sub {
674	$HOST->set_text ($CFG->{host} = $host);	924	$HOST_ENTRY->set_text ($CFG->{profile}{default}{host} = $host);
		925	$METASERVER->hide;
		926	0
		927	},
675	}),	928	),
676	(new CFClient::UI::Empty expand => 1),	929	(new CFClient::UI::Empty expand => 1),
677	]);	930	]);
678		931
679	$table->add ($_ + 1, $y, new CFClient::UI::Label	932	$table->add ($_, $y, new CFClient::UI::Label
680	ellipsise => 0, align => $align[$_], text => $m->[$_], fontsize => 0.8)	933	ellipsise => 0,
		934	align => $align[$_],
		935	text => $m->[$_],
		936	tooltip => $tip[$_],
		937	can_hover => 1,
		938	can_events => 1,
		939	fontsize => 0.8)
681	for 0 .. $#$m;	940	for 0 .. $#$m;
682	}	941	}
683	}	942	}
684	});	943	});
685	}	944	}
686		945
		946	sub metaserver_dialog {
		947	my $vbox = new CFClient::UI::VBox;
		948	my $table = new CFClient::UI::Table;
		949	$vbox->add (new CFClient::UI::ScrolledWindow expand => 1, child => $table);
		950
		951	my $dialog = new CFClient::UI::FancyFrame
		952	title => "Server List",
		953	name => 'metaserver_dialog',
		954	x => 'center',
		955	y => 'center',
		956	z => 3,
		957	force_h => $::HEIGHT * 0.4,
		958	child => $vbox,
		959	has_close_button => 1,
		960	table => $table,
		961	on_visibility_change => sub {
		962	update_metaserver ($_[0]) if $_[1];
		963	0
		964	},
		965	;
		966
		967	$dialog
		968	}
		969
687	sub server_setup {	970	sub server_setup {
688	my $dialog = new CFClient::UI::FancyFrame
689	title => "Server Setup",
690	child => (my $vbox = new CFClient::UI::VBox);	971	my $vbox = new CFClient::UI::VBox;
691		972
692	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);	973	$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");	974	$table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
694		975
695	{	976	{
696	$table->add (1, 2, my $vbox = new CFClient::UI::VBox);	977	$table->add (1, 2, my $vbox = new CFClient::UI::VBox);
697		978
698	$vbox->add (	979	$vbox->add (
699	my $HOST = new CFClient::UI::Entry	980	$HOST_ENTRY = new CFClient::UI::Entry
700	expand => 1,	981	expand => 1,
701	text => $CFG->{host},	982	text => $CFG->{profile}{default}{host},
702	tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",	983	tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
703	connect_changed => sub {	984	on_changed => sub {
704	my ($self, $value) = @_;	985	my ($self, $value) = @_;
705	$CFG->{host} = $value;	986	$CFG->{profile}{default}{host} = $value;
		987	0
706	}	988	}
707	);	989	);
708		990
709	$METASERVER = metaserver_dialog;
710
711	$vbox->add (new CFClient::UI::Flopper	991	$vbox->add (new CFClient::UI::Button
712	expand => 1,	992	expand => 1,
713	text => "Server List",	993	text => "Server List",
714	other => $METASERVER,	994	other => $METASERVER,
715	tooltip => "Show a list of available crossfire servers",	995	tooltip => "Show a list of available crossfire servers",
716	connect_open => sub {	996	on_activate => sub { $METASERVER->toggle_visibility; 0 },
717	update_metaserver $HOST;	997	on_visibility_change => sub { $METASERVER->hide unless $_[1]; 0 },
718	}
719	);	998	);
720	}	999	}
721		1000
722	$table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");	1001	$table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
723	$table->add (1, 4, new CFClient::UI::Entry	1002	$table->add (1, 4, new CFClient::UI::Entry
724	text => $CFG->{user},	1003	text => $CFG->{profile}{default}{user},
725	tooltip => "The name of your character on the server",	1004	tooltip => "The name of your character on the server",
726	connect_changed => sub {	1005	on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{user} = $value }
727	my ($self, $value) = @_;
728	$CFG->{user} = $value;
729	}
730	);	1006	);
731		1007
732	$table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");	1008	$table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
733	$table->add (1, 5, new CFClient::UI::Entry	1009	$table->add (1, 5, new CFClient::UI::Entry
734	text => $CFG->{password},	1010	text => $CFG->{profile}{default}{password},
735	hidden => 1,	1011	hidden => 1,
736	tooltip => "The password for your character",	1012	tooltip => "The password for your character",
737	connect_changed => sub {	1013	on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{password} = $value }
738	my ($self, $value) = @_;
739	$CFG->{password} = $value;
740	}
741	);	1014	);
742		1015
743	$table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");	1016	$table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
744	$table->add (1, 7, new CFClient::UI::Slider	1017	$table->add (1, 7, new CFClient::UI::Slider
745	req_w => 100,	1018	force_w => 100,
746	range => [$CFG->{mapsize}, 10, 100, 0, 1],	1019	range => [$CFG->{mapsize}, 10, 100, 0, 1],
747	tooltip => "This is the size of the portion of the map update the server sends you. "	1020	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, "	1021	. "If you set this to a high value you will be able to see further, "
749	. "but you also increase bandwidth requirements and latency. "	1022	. "but you also increase bandwidth requirements and latency. "
750	. "This option is only used once at log-in.",	1023	. "This option is only used once at log-in.",
751	connect_changed => sub {	1024	on_changed => sub { my ($self, $value) = @_; $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 0 },
752	my ($self, $value) = @_;
753
754	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;
755	},
756	);	1025	);
757		1026
758	$table->add (0, 8, new CFClient::UI::Label valign => 0, align => 1, text => "Face Prefetch");	1027	$table->add (0, 8, new CFClient::UI::Label valign => 0, align => 1, text => "Face Prefetch");
759	$table->add (1, 8, new CFClient::UI::CheckBox	1028	$table->add (1, 8, new CFClient::UI::CheckBox
760	state => $CFG->{face_prefetch},	1029	state => $CFG->{face_prefetch},
…		…
763	. "This might increase or create lag, but increases the chances "	1032	. "This might increase or create lag, but increases the chances "
764	. "of faces being ready for display when you encounter them. "	1033	. "of faces being ready for display when you encounter them. "
765	. "It also uses up server bandwidth on every connect, "	1034	. "It also uses up server bandwidth on every connect, "
766	. "so only set it if you really need to prefetch images. "	1035	. "so only set it if you really need to prefetch images. "
767	. "This option can be set and unset any time.",	1036	. "This option can be set and unset any time.",
768	connect_changed => sub { $CFG->{face_prefetch} = $_[1] },	1037	on_changed => sub { $CFG->{face_prefetch} = $_[1]; 0 },
769	);	1038	);
770		1039
771	$table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");	1040	$table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");
772	$table->add (1, 9, new CFClient::UI::Entry	1041	$table->add (1, 9, new CFClient::UI::Entry
773	text => $CFG->{output_count},	1042	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.",	1043	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] },	1044	on_changed => sub { $CFG->{output_count} = $_[1]; 0 },
776	);	1045	);
777		1046
778	$table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");	1047	$table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");
779	$table->add (1, 10, new CFClient::UI::Entry	1048	$table->add (1, 10, new CFClient::UI::Entry
780	text => $CFG->{output_sync},	1049	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.",	1050	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] },	1051	on_changed => sub { $CFG->{output_sync} = $_[1]; 0 },
783	);	1052	);
784		1053
785	$table->add (1, 11, $LOGIN_BUTTON = new CFClient::UI::Button	1054	$table->add (1, 11, $LOGIN_BUTTON = new CFClient::UI::Button
786	expand => 1,	1055	expand => 1,
787	align => 0,	1056	align => 0,
788	text => "Login",	1057	text => "Login",
789	connect_activate => sub {	1058	on_activate => sub {
790	$CONN ? stop_game	1059	$CONN ? stop_game
791	: start_game;	1060	: start_game;
		1061	0
792	},	1062	},
793	);	1063	);
794		1064
795	$dialog	1065	$table->add (0, 12, new CFClient::UI::Label valign => 0, align => 1, text => "Chat Command");
		1066	$table->add (1, 12, my $saycmd = new CFClient::UI::Entry
		1067	text => $CFG->{say_command},
		1068	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. "
		1069	. "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
		1070	. "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
		1071	on_changed => sub {
		1072	my ($self, $value) = @_;
		1073	$CFG->{say_command} = $value;
		1074	0
		1075	}
		1076	);
		1077
		1078	$vbox->add (new CFClient::UI::Label
		1079	text => "Server Info",
		1080	fontsize => 1.2,
		1081	padding_y => 8,
		1082	fg => [1, 1, 0, 1],
		1083	);
		1084
		1085	$vbox->add ($SERVER_INFO = new CFClient::UI::Label ellipsise => 0);
		1086
		1087	$vbox
796	}	1088	}
797		1089
798	sub message_window {	1090	sub message_window {
799	my $window = new CFClient::UI::FancyFrame	1091	my $window = new CFClient::UI::FancyFrame
		1092	name => "message_window",
800	title => "Messages",	1093	title => "Messages",
801	border_bg => [1, 1, 1, 1],	1094	border_bg => [1, 1, 1, 1],
802	bg => [0, 0, 0, 0.75],	1095	bg => [0, 0, 0, 0.75],
803	user_w => int $::WIDTH / 3,	1096	x => "max",
		1097	y => 0,
		1098	force_w => $::WIDTH * 0.4,
804	user_h => int $::HEIGHT / 5,	1099	force_h => $::HEIGHT * 0.5,
805	child => (my $vbox = new CFClient::UI::VBox);	1100	child => (my $vbox = new CFClient::UI::VBox),
		1101	has_close_button => 1;
806		1102
807	$vbox->add ($LOGVIEW);	1103	$vbox->add ($LOGVIEW);
808		1104
809	$vbox->add (my $input = new CFClient::UI::Entry	1105	$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> "	1106	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>...). "	1107	. "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). "	1108	. "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.",	1109	. "A better way to submit commands (and the occasional chat command) is often the map command completer.",
814	connect_focus_in => sub {	1110	on_focus_in => sub {
815	my ($input, $prev_focus) = @_;	1111	my ($input, $prev_focus) = @_;
816		1112
817	delete $input->{refocus_map};	1113	delete $input->{refocus_map};
818		1114
819	if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {	1115	if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
820	$input->{refocus_map} = 1;	1116	$input->{refocus_map} = 1;
821	}	1117	}
822	delete $input->{auto_activated};	1118	delete $input->{auto_activated};
		1119
		1120	0
823	},	1121	},
824	connect_activate => sub {	1122	on_activate => sub {
825	my ($input, $text) = @_;	1123	my ($input, $text) = @_;
826	$input->set_text ('');	1124	$input->set_text ('');
827		1125
828	if ($text =~ /^\/(.*)/) {	1126	if ($text =~ /^\/(.*)/) {
829	$::CONN->user_send ($1);	1127	$::CONN->user_send ($1);
…		…
833	}	1131	}
834	if ($input->{refocus_map}) {	1132	if ($input->{refocus_map}) {
835	delete $input->{refocus_map};	1133	delete $input->{refocus_map};
836	$MAPWIDGET->focus_in	1134	$MAPWIDGET->focus_in
837	}	1135	}
		1136
		1137	0
838	},	1138	},
839	connect_escape => sub {	1139	on_escape => sub {
840	$MAPWIDGET->focus_in	1140	$MAPWIDGET->grab_focus;
		1141
		1142	0
841	},	1143	},
842	);	1144	);
843		1145
844	$CONSOLE = {	1146	$CONSOLE = {
845	window => $window,	1147	window => $window,
846	input => $input	1148	input => $input,
847	};	1149	};
848		1150
849	$window	1151	$window
850	}	1152	}
851		1153
852	sub open_quit_dialog {	1154	sub open_quit_dialog {
853	unless ($QUIT_DIALOG) {	1155	unless ($QUIT_DIALOG) {
854
855	$QUIT_DIALOG = new CFClient::UI::FancyFrame title => "Really Quit?";	1156	$QUIT_DIALOG = new CFClient::UI::FancyFrame
		1157	x => "center",
		1158	y => "center",
		1159	z => 50,
		1160	title => "Really Quit?",
		1161	;
856		1162
857	$QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);	1163	$QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);
858		1164
859	$vb->add (new CFClient::UI::Label	1165	$vb->add (new CFClient::UI::Label
860	text => "You should find a savebed and apply it first!",	1166	text => "You should find a savebed and apply it first!",
…		…
863	);	1169	);
864	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);	1170	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
865	$hb->add (new CFClient::UI::Button	1171	$hb->add (new CFClient::UI::Button
866	text => "Ok",	1172	text => "Ok",
867	expand => 1,	1173	expand => 1,
868	connect_activate => sub { $QUIT_DIALOG->hide },	1174	on_activate => sub { $QUIT_DIALOG->hide; 0 },
869	);	1175	);
870	$hb->add (new CFClient::UI::Button	1176	$hb->add (new CFClient::UI::Button
871	text => "Quit anyway",	1177	text => "Quit anyway",
872	expand => 1,	1178	expand => 1,
873	connect_activate => sub { exit },	1179	on_activate => sub { exit },
874	);
875
876	$QUIT_DIALOG->show_centered;
877	} else {
878	$QUIT_DIALOG->show_centered;
879	}
880	}
881
882	sub make_inventory_window {
883	my $invwin = new CFClient::UI::FancyFrame
884	user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Inventory";
885
886	$invwin->add (my $hb = new CFClient::UI::HBox expand => 1);
887
888	$hb->add (my $vb1 = new CFClient::UI::VBox expand => 1);
889	$vb1->add (my $lbl = new CFClient::UI::Label);
890	$lbl->set_text ("Player");
891	$vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
892
893	$hb->add (my $vb2 = new CFClient::UI::VBox expand => 1);
894	$vb2->add ($INVR_LBL = new CFClient::UI::Label);
895	$INVR_LBL->set_text ("Floor");
896	$vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);
897
898	$invwin
899	}
900
901	sub make_help_window {
902	my $win = new CFClient::UI::FancyFrame
903	user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Documentation";
904
905	$win->add (my $vbox = new CFClient::UI::VBox);
906
907	$vbox->add (my $buttons = new CFClient::UI::HBox);
908	$vbox->add (my $viewer = new CFClient::UI::TextView expand => 1, fontsize => 0.8);
909
910	for (
911	[intro => "Introduction"],
912	[manual => "Manual"],
913	[command_help => "Commands"],
914	[skill_help => "Skills"],
915	) {
916	my ($pod, $label) = @$_;
917
918	$buttons->add (new CFClient::UI::Button
919	text => $label,
920	connect_activate => sub {
921	my $parser = new Pod::POM;
922	my $pom = $parser->parse_file (CFClient::find_rcfile "pod/$pod.pod");
923
924	$viewer->clear;
925
926	$viewer->add_paragraph ([1, 1, 1, 1], $_->[1], $_->[0])
927	for @{ CFClient::pod_to_pango_list $pom };
928
929	$viewer->set_offset (0);
930	},
931	);	1180	);
932	}	1181	}
933		1182
934	$viewer->add_paragraph ([1, 1, 0, 1], "<big>Use one of the buttons above to display a document.</big>");	1183	$QUIT_DIALOG->show;
		1184	}
		1185
		1186	sub autopickup_setup {
		1187	my $table = new CFClient::UI::Table;
		1188
		1189	for (
		1190	["General", 0, 0,
		1191	["Enable autopickup" => PICKUP_NEWMODE],
		1192	["Inhibit autopickup" => PICKUP_INHIBIT],
		1193	["Stop before pickup" => PICKUP_STOP],
		1194	["Debug autopickup" => PICKUP_DEBUG],
		1195	],
		1196	["Weapons", 0, 6,
		1197	["All weapons" => PICKUP_ALLWEAPON],
		1198	["Missile weapons" => PICKUP_MISSILEWEAPON],
		1199	["Bows" => PICKUP_BOW],
		1200	["Arrows" => PICKUP_ARROW],
		1201	],
		1202	["Armour", 0, 12,
		1203	["Helmets" => PICKUP_HELMET],
		1204	["Shields" => PICKUP_SHIELD],
		1205	["Body Armour" => PICKUP_ARMOUR],
		1206	["Boots" => PICKUP_BOOTS],
		1207	["Gloves" => PICKUP_GLOVES],
		1208	["Cloaks" => PICKUP_CLOAK],
		1209	],
		1210
		1211	["Readables", 2, 2,
		1212	["Spellbooks" => PICKUP_SPELLBOOK],
		1213	["Skillscrolls" => PICKUP_SKILLSCROLL],
		1214	["Normal Books/Scrolls" => PICKUP_READABLES],
		1215	],
		1216	["Misc", 2, 7,
		1217	["Food" => PICKUP_FOOD],
		1218	["Drinks" => PICKUP_DRINK],
		1219	["Valuables (Money, Gems)" => PICKUP_VALUABLES],
		1220	["Keys" => PICKUP_KEY],
		1221	["Magical Items" => PICKUP_MAGICAL],
		1222	["Potions" => PICKUP_POTION],
		1223	["Magic Devices" => PICKUP_MAGIC_DEVICE],
		1224	["Ignore cursed" => PICKUP_NOT_CURSED],
		1225	["Jewelery" => PICKUP_JEWELS],
		1226	],
		1227	["Weight/Value ratio", 2, 17]
		1228	)
		1229	{
		1230	my ($title, $x, $y, @bits) = @$_;
		1231	$table->add ($x, $y, new CFClient::UI::Label text => $title, align => 1, fg => [1, 1, 0]);
		1232
		1233	for (@bits) {
		1234	++$y;
		1235
		1236	my $mask = $_->[1];
		1237	$table->add ($x , $y, new CFClient::UI::Label text => $_->[0], align => 1, expand => 1);
		1238	$table->add ($x+1, $y, new CFClient::UI::CheckBox
		1239	state => $::CFG->{pickup} & $mask,
		1240	on_changed => sub {
		1241	my ($box, $value) = @_;
		1242
		1243	if ($value) {
		1244	$::CFG->{pickup} |= $mask;
		1245	} else {
		1246	$::CFG->{pickup} &= ~$mask;
		1247	}
		1248
		1249	$::CONN->send_command ("pickup $::CFG->{pickup}")
		1250	if defined $::CONN;
		1251
		1252	0
		1253	});
		1254	}
		1255	}
		1256
		1257	$table->add (2, 18, new CFClient::UI::ValSlider
		1258	range => [$::CFG->{pickup} & 0xF, 0, 16, 1, 1],
		1259	template => ">= 99",
		1260	to_value => sub { ">= " . 5 * $_[0] },
		1261	on_changed => sub {
		1262	my ($slider, $value) = @_;
		1263
		1264	$::CFG->{pickup} &= ~0xF;
		1265	$::CFG->{pickup} |= int $value
		1266	if $value;
		1267	1;
		1268	});
		1269
		1270	$table->add (3, 18, new CFClient::UI::Button
		1271	text => "set",
		1272	on_activate => sub {
		1273	$::CONN->send_command ("pickup $::CFG->{pickup}")
		1274	if defined $::CONN;
		1275	0
		1276	});
		1277
		1278	$table
		1279	}
		1280
		1281	sub inventory_widget {
		1282	my $hb = new CFClient::UI::HBox homogeneous => 1;
		1283
		1284	$hb->add (my $vb1 = new CFClient::UI::VBox);
		1285	$vb1->add (new CFClient::UI::Label align => 0, text => "Player");
		1286	$vb1->add ($INV = new CFClient::UI::Inventory);
		1287
		1288	$hb->add (my $vb2 = new CFClient::UI::VBox);
		1289
		1290	$vb2->add ($INV_RIGHT_HB = new CFClient::UI::HBox);
		1291
		1292	$vb2->add ($INVR = new CFClient::UI::Inventory);
		1293
		1294	# XXX: Call after $INVR = ... because set_opencont sets the items
		1295	CFClient::Protocol::set_opencont ($::CONN, 0, "Floor");
		1296
		1297	$hb
		1298	}
		1299
		1300	sub player_window {
		1301	my $plwin = $PL_WINDOW = new CFClient::UI::FancyFrame
		1302	x => "center",
		1303	y => "center",
		1304	force_w => $WIDTH * 9/10,
		1305	force_h => $HEIGHT * 9/10,
		1306	title => "Player",
		1307	has_close_button => 1
		1308	;
		1309
		1310	my $ntb =
		1311	$PL_NOTEBOOK =
		1312	new CFClient::UI::Notebook
		1313	expand => 1,
		1314	debug => 1,
		1315	filter => (new CFClient::UI::ScrolledWindow expand => 1, scroll_y => 1),
		1316	;
		1317	$ntb->add (
		1318	Inventory => inventory_widget,
		1319	"Toggles the inventory window, where you can manage your loot (or treasures :). "
		1320	. "You can also hit the <b>Tab</b>-key to show/hide the Inventory."
		1321	);
		1322
		1323	$ntb->add (
		1324	Stats => $STATS_WINDOW = stats_window,
		1325	"Toggles the statistics window, where all your Stats and Resistances are being displayed at all times."
		1326	);
		1327	$ntb->add (
		1328	Spells => $SETUP_SPELLS = new CFClient::UI::SpellList,
		1329	"Displays all spells you have and lets you edit keyboard shortcuts for them."
		1330	);
		1331
		1332	$plwin->add ($ntb);
		1333	$plwin
		1334	}
		1335
		1336	sub update_bindings {
		1337	$BIND_UPD_CB->() if $BIND_UPD_CB;
		1338	}
		1339
		1340	sub keyboard_setup {
		1341	my $binding_list = new CFClient::UI::VBox;
		1342
		1343	my $refresh;
		1344	$refresh = $BIND_UPD_CB = sub {
		1345	$binding_list->clear ();
		1346
		1347	for my $mod (keys %{$::CFG->{profile}{default}{bindings}}) {
		1348	for my $sym (keys %{$::CFG->{profile}{default}{bindings}{$mod}}) {
		1349	my $cmds = $::CFG->{profile}{default}{bindings}{$mod}{$sym};
		1350	next unless ref $cmds eq 'ARRAY' and @$cmds > 0;
		1351
		1352	my $lbl = join "; ", @$cmds;
		1353	my $nam = CFClient::BindingEditor::keycombo_to_name ($mod, $sym);
		1354	$binding_list->add (my $hb = new CFClient::UI::HBox);
		1355	$hb->add (new CFClient::UI::Button
		1356	text => "delete",
		1357	tooltip => "Deletes the binding",
		1358	on_activate => sub {
		1359	$binding_list->remove ($hb);
		1360	delete $::CFG->{profile}{default}{bindings}{$mod}{$sym};
		1361	0
		1362	});
		1363
		1364	$hb->add (new CFClient::UI::Button
		1365	text => "edit",
		1366	tooltip => "Edits the binding",
		1367	on_activate => sub {
		1368	$::BIND_EDITOR->set_binding (
		1369	$mod, $sym, $::CFG->{profile}{default}{bindings}{$mod}{$sym},
		1370	sub {
		1371	my ($nmod, $nsym, $ncmds) = @_;
		1372	$::BIND_EDITOR->cfg_unbind ($mod, $sym);
		1373	$::BIND_EDITOR->cfg_bind ($nmod, $nsym, $ncmds);
		1374	$refresh->();
		1375	$SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
		1376	$SETUP_DIALOG->show;
		1377	},
		1378	sub {
		1379	$SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
		1380	$SETUP_DIALOG->show;
		1381	});
		1382	$::BIND_EDITOR->show;
		1383	$SETUP_DIALOG->hide;
		1384	0
		1385	});
		1386
		1387	$hb->add (new CFClient::UI::Label text => "(Key: $nam)");
		1388	$hb->add (new CFClient::UI::Label text => $lbl, expand => 1);
		1389	}
		1390	}
		1391	};
		1392
		1393	my $vb = new CFClient::UI::VBox;
		1394	$vb->add (my $hb = new CFClient::UI::HBox);
		1395	$hb->add (new CFClient::UI::Label text => "only shift-up stops fire");
		1396	$hb->add (new CFClient::UI::CheckBox
		1397	expand => 1,
		1398	state => $CFG->{shift_fire_stop},
		1399	tooltip => "If this checkbox is enabled you will stop fire only if you stop pressing shift",
		1400	on_changed => sub {
		1401	my ($cbox, $value) = @_;
		1402	$CFG->{shift_fire_stop} = $value;
		1403	0
		1404	});
		1405
		1406	$vb->add ($binding_list);
		1407	$vb->add (my $hb = new CFClient::UI::HBox);
		1408
		1409	$hb->add (new CFClient::UI::Button
		1410	text => "record new",
		1411	expand => 1,
		1412	tooltip => "This button opens the binding editor with an empty binding.",
		1413	on_activate => sub {
		1414	$::BIND_EDITOR->set_binding (undef, undef, [],
		1415	sub {
		1416	my ($mod, $sym, $cmds) = @_;
		1417	$::BIND_EDITOR->cfg_bind ($mod, $sym, $cmds);
		1418	$refresh->();
		1419	$SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
		1420	$SETUP_DIALOG->show;
		1421	},
		1422	sub {
		1423	$SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
		1424	$SETUP_DIALOG->show;
		1425	},
		1426	);
		1427	$SETUP_DIALOG->hide;
		1428	$::BIND_EDITOR->show;
		1429	0
		1430	},
		1431	);
		1432
		1433	$hb->add (new CFClient::UI::Button
		1434	text => "close",
		1435	tooltip => "Closes the binding window",
		1436	expand => 1,
		1437	on_activate => sub {
		1438	$SETUP_DIALOG->hide;
		1439	0
		1440	}
		1441	);
		1442
		1443	$refresh->();
		1444
		1445	$vb
		1446	}
		1447
		1448	sub help_window {
		1449	my $win = new CFClient::UI::FancyFrame
		1450	x => 'center',
		1451	y => 'center',
		1452	z => 2,
		1453	name => 'doc_browser',
		1454	force_w => int $WIDTH * 7/8,
		1455	force_h => int $HEIGHT * 7/8,
		1456	title => "Documentation";
		1457
		1458	$win->add (my $vbox = new CFClient::UI::VBox);
		1459
		1460	$vbox->add (my $buttons = new CFClient::UI::HBox);
		1461	$vbox->add (my $viewer = new CFClient::UI::TextScroller
		1462	expand => 1, fontsize => 0.8, padding_x => 4);
		1463
		1464	$buttons->add (new CFClient::UI::Label text => "Choose a document to display: ");
		1465	$buttons->add (my $combo = new CFClient::UI::Combobox
		1466	value => undef,
		1467	options => [
		1468	[intro => "Introduction"],
		1469	[manual => "Main Manual"],
		1470	[skill_help => "Skill Reference"],
		1471	[command_help => "Command Reference"],
		1472	[dmcommand_help => "DM Commands"],
		1473	[COPYING => "License Terms"],
		1474	],
		1475	on_changed => sub {
		1476	my ($self, $pod) = @_;
		1477
		1478	my $pom = CFClient::load_pod CFClient::find_rcfile "pod/$pod.pod",
		1479	doc_viewer => 1, sub { CFClient::pod_to_pango_list $_[0] };
		1480
		1481	$viewer->clear;
		1482
		1483	# $viewer->add_paragraph ([1, 1, 1, 1], ["<big>Test</big>\n\n \x{fffc} \x{fffc}\n",
		1484	# (new CFClient::UI::Image path => "x.png", can_hover => 1, can_events => 1),
		1485	# (new CFClient::UI::Label text => "üüüü", can_hover => 1, can_events => 1, tooltip => "??"),
		1486	# ]);#d#
		1487
		1488	$viewer->add_paragraph ([1, 1, 1, 1], $_->[1], $_->[0])
		1489	for @$pom;
		1490
		1491	$viewer->set_offset (0);
		1492
		1493	0
		1494	},
		1495	on_visibility_change => sub {
		1496	my ($self, $visible) = @_;
		1497	return unless $visible;
		1498	return if $self->{value};
		1499	$self->set_value ("intro");
		1500	0
		1501	},
		1502	);
935		1503
936	$win	1504	$win
937	}	1505	}
938		1506
939	sub sdl_init {	1507	sub sdl_init {
…		…
956	or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";	1524	or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";
957		1525
958	$SDL_ACTIVE = 1;	1526	$SDL_ACTIVE = 1;
959	$LAST_REFRESH = time - 0.01;	1527	$LAST_REFRESH = time - 0.01;
960		1528
961	CFClient::gl_init;	1529	CFClient::OpenGL::init;
962		1530
963	$FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};	1531	$FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
964		1532
965	$CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#	1533	$CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
966		1534
…		…
969	if ($DEBUG_STATUS) {	1537	if ($DEBUG_STATUS) {
970	CFClient::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;	1538	CFClient::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
971	} else {	1539	} else {
972	# create the widgets	1540	# create the widgets
973		1541
974	$DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100, req_x => -1;	1542	$DEBUG_STATUS = new CFClient::UI::Label
		1543	padding => 0,
		1544	z => 100,
		1545	force_x => "max",
		1546	force_y => 0;
975	$DEBUG_STATUS->show;	1547	$DEBUG_STATUS->show;
976		1548
		1549	$BIND_EDITOR = new CFClient::BindingEditor (x => "max", y => 0);
		1550
977	$STATUSBOX = new CFClient::UI::Statusbox;	1551	$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]);	1552	$STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);
979		1553
980	(new CFClient::UI::Frame	1554	(new CFClient::UI::Frame
981	bg => [0, 0, 0, 0.4],	1555	bg => [0, 0, 0, 0.4],
982	req_y => -1,	1556	force_x => 0,
		1557	force_y => "max",
983	child => $STATUSBOX,	1558	child => $STATUSBOX,
984	)->show;	1559	)->show;
985		1560
986	CFClient::UI::FancyFrame->new (	1561	CFClient::UI::FancyFrame->new (
		1562	title => "Map",
		1563	name => "mapmap",
		1564	x => 0,
		1565	y => $FONTSIZE + 8,
987	border_bg => [1, 1, 1, 192/255],	1566	border_bg => [1, 1, 1, 192/255],
988	bg => [1, 1, 1, 0],	1567	bg => [1, 1, 1, 0],
989	child => ($MAPMAP = new CFClient::MapWidget::MapMap	1568	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.",	1569	tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
991	),	1570	),
…		…
995	$MAPWIDGET->connect (activate_console => sub {	1574	$MAPWIDGET->connect (activate_console => sub {
996	my ($mapwidget, $preset) = @_;	1575	my ($mapwidget, $preset) = @_;
997		1576
998	if ($CONSOLE) {	1577	if ($CONSOLE) {
999	$CONSOLE->{input}->{auto_activated} = 1;	1578	$CONSOLE->{input}->{auto_activated} = 1;
1000	$CONSOLE->{input}->focus_in;	1579	$CONSOLE->{input}->grab_focus;
1001		1580
1002	if ($preset && $CONSOLE->{input}->get_text eq '') {	1581	if ($preset && $CONSOLE->{input}->get_text eq '') {
1003	$CONSOLE->{input}->set_text ($preset);	1582	$CONSOLE->{input}->set_text ($preset);
1004	}	1583	}
1005	}	1584	}
1006	});	1585	});
1007	$MAPWIDGET->show;	1586	$MAPWIDGET->show;
1008	$MAPWIDGET->focus_in;	1587	$MAPWIDGET->grab_focus;
1009		1588
1010	$LOGVIEW = new CFClient::UI::TextView	1589	$LOGVIEW = new CFClient::UI::TextScroller
1011	expand => 1,	1590	expand => 1,
1012	font => $FONT_FIXED,	1591	font => $FONT_FIXED,
1013	fontsize => $::CFG->{log_fontsize},	1592	fontsize => $::CFG->{log_fontsize},
		1593	indent => -4,
1014	can_hover => 1,	1594	can_hover => 1,
1015	can_events => 1,	1595	can_events => 1,
1016	tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",	1596	tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",
1017	;	1597	;
1018		1598
1019	$BUTTONBAR = new CFClient::UI::HBox;	1599	$SETUP_DIALOG = new CFClient::UI::FancyFrame
		1600	title => "Setup",
		1601	name => "setup_dialog",
		1602	x => 'center',
		1603	y => 'center',
		1604	z => 2,
		1605	force_w => $::WIDTH * 0.6,
		1606	force_h => $::HEIGHT * 0.6,
		1607	has_close_button => 1,
		1608	;
1020		1609
		1610	$METASERVER = metaserver_dialog;
		1611
		1612	$SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFClient::UI::Notebook expand => 1, debug => 1,
		1613	filter => new CFClient::UI::ScrolledWindow expand => 1, scroll_y => 1);
		1614
		1615	$SETUP_NOTEBOOK->add (Server => $SETUP_SERVER = server_setup,
		1616	"Configure the server to play on, your username, password and other server-related options.");
		1617	$SETUP_NOTEBOOK->add (Pickup => autopickup_setup,
		1618	"Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them.");
		1619	$SETUP_NOTEBOOK->add (Graphics => graphics_setup,
		1620	"Configure the video mode, performance, fonts and other graphical aspects of the game.");
		1621	$SETUP_NOTEBOOK->add (Audio => audio_setup,
		1622	"Configure the use of audio, sound effects and background music.");
		1623	$SETUP_NOTEBOOK->add (Keyboard => $SETUP_KEYBOARD = keyboard_setup,
		1624	"Lets you define, edit and delete key bindings."
		1625	. "There is a shortcut for making bindings: <b>Control-Insert</b> opens the binding editor "
		1626	. "with nothing set and the recording started. After doing the actions you "
		1627	. "want to record press <b>Insert</b> and you will be asked to press a key-combo. "
		1628	. "After pressing the combo the binding will be saved automatically and the "
		1629	. "binding editor closes");
		1630	$SETUP_NOTEBOOK->add (Debug => debug_setup,
		1631	"Some debuggin' options. Do not ask.");
		1632
		1633	$BUTTONBAR = new CFClient::UI::Buttonbar x => 0, y => 0, z => 200; # put on top
		1634
1021	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup,	1635	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Setup", other => $SETUP_DIALOG,
1022	tooltip => "Toggles a dialog where you can configure various aspects of the client, such as graphics mode, performance, and audio options.");	1636	tooltip => "Toggles a dialog where you can configure all aspects of this client.");
1023	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup,	1637
1024	tooltip => "Toggles a dialog where you can configure the server to play on, your username, password and other server-related options.");
1025	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window,	1638	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW = message_window,
1026	tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");	1639	tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
1027		1640
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	1641	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		1642
1030	$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.");
1032	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => make_inventory_window,	1643	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Player", other => player_window,
1033	tooltip => "Toggles the inventory window, where you can manage your loot (or treaures :).");	1644	tooltip => "Toggles the player view, where you can manage Inventory, Spells, Skills and see your Stats.");
1034		1645
1035	$BUTTONBAR->add (new CFClient::UI::Button	1646	$BUTTONBAR->add (new CFClient::UI::Button
1036	text => "Save Config",	1647	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.",	1648	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 {	1649	on_activate => sub {
		1650	$::CFG->{layout} = CFClient::UI::get_layout;
1039	CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";	1651	CFClient::write_cfg "$Crossfire::VARDIR/cfplusrc";
1040	status "Configuration Saved";	1652	status "Configuration Saved";
		1653	0
1041	},	1654	},
1042	);	1655	);
1043		1656
1044	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => make_help_window,	1657	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => help_window,
1045	tooltip => "View Documentation");	1658	tooltip => "View Documentation");
1046		1659
1047	$BUTTONBAR->add (new CFClient::UI::Button	1660	$BUTTONBAR->add (new CFClient::UI::Button
1048	text => "Quit",	1661	text => "Quit",
1049	tooltip => "Terminates the program",	1662	tooltip => "Terminates the program",
1050	connect_activate => sub {	1663	on_activate => sub {
1051	if ($CONN) {	1664	if ($CONN) {
1052	open_quit_dialog;	1665	open_quit_dialog;
1053	} else {	1666	} else {
1054	exit;	1667	exit;
1055	}	1668	}
		1669	0
1056	},	1670	},
1057	);	1671	);
1058		1672
1059	$BUTTONBAR->show;	1673	$BUTTONBAR->show;
1060		1674	$SETUP_DIALOG->show;
1061	$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	}	1675	}
		1676
		1677	$STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
1071	}	1678	}
1072		1679
1073	sub video_shutdown {	1680	sub video_shutdown {
		1681	CFClient::OpenGL::shutdown;
		1682
1074	undef $SDL_ACTIVE;	1683	undef $SDL_ACTIVE;
1075	}	1684	}
1076		1685
1077	my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#	1686	my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
1078	my $bgmusic;#TODO#hack#d#	1687	my $bgmusic;#TODO#hack#d#
…		…
1142		1751
1143	my %demo;#d#	1752	my %demo;#d#
1144		1753
1145	sub force_refresh {	1754	sub force_refresh {
1146	$fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;	1755	$fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
1147	debug sprintf "%3.2f", $fps;	1756	debug sprintf "%3.2f", $fps if $ENV{CFPLUS_DEBUG} & 4;
1148		1757
1149	$CFClient::UI::ROOT->draw;	1758	$CFClient::UI::ROOT->draw;
1150		1759
1151	$WANT_REFRESH = 0;	1760	$WANT_REFRESH = 0;
1152	$CAN_REFRESH = 0;	1761	$CAN_REFRESH = 0;
…		…
1207	};	1816	};
1208		1817
1209	CFClient::SDL_GL_SwapBuffers;	1818	CFClient::SDL_GL_SwapBuffers;
1210	}	1819	}
1211		1820
1212	my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {	1821	my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub {
1213	$NOW = time;	1822	$NOW = time;
1214		1823
1215	($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)	1824	($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
1216	for CFClient::SDL_PollEvent;	1825	for CFClient::SDL_PollEvent;
1217		1826
…		…
1235	sub animation_stop {	1844	sub animation_stop {
1236	my ($widget) = @_;	1845	my ($widget) = @_;
1237	delete $animate_object{$widget};	1846	delete $animate_object{$widget};
1238	}	1847	}
1239		1848
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	1849	# check once/second for faces that need to be prefetched
1735	# this should, of course, only run on demand, but	1850	# this should, of course, only run on demand, but
1736	# SDL forces worse things on us....	1851	# SDL forces worse things on us....
1737		1852
1738	Event->timer (after => 1, interval => 0.25, cb => sub {	1853	Event->timer (after => 1, interval => 0.25, cb => sub {
1739	$CONN->face_prefetch	1854	$CONN->face_prefetch
1740	if $CONN;	1855	if $CONN;
1741	});	1856	});
1742
1743	sub update_floorbox {
1744	$CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
1745	return unless $CONN;
1746
1747	$FLOORBOX->clear;
1748	$FLOORBOX->add (new CFClient::UI::Empty expand => 1);
1749
1750	my $count = 7;
1751	for (@{ $CONN->{container}{0} }) {
1752	if (--$count) {
1753	$FLOORBOX->add (new CFClient::UI::InventoryItem item => $_);
1754	} else {
1755	$FLOORBOX->add (new CFClient::UI::Label text => "More...");
1756	last;
1757	}
1758	}
1759	});
1760
1761	$WANT_REFRESH++;
1762	}
1763
1764	sub conn::container_add {
1765	my ($self, $tag, $items) = @_;
1766
1767	#d# print "container_add: container $tag ($self->{player}{tag})\n";
1768
1769	if ($tag == 0) {
1770	update_floorbox;
1771	$OPENCONT = 0;
1772	$INVR_LBL->set_text ("Floor");
1773	$INVR->set_items ($self->{container}{0});
1774	} elsif ($tag == $self->{player}{tag}) {
1775	$INVR_LBL->set_text ("Player");
1776	$INV->set_items ($self->{container}{$self->{player}{tag}})
1777	} else {
1778	$OPENCONT = $tag;
1779	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1780	$INVR->set_items ($self->{container}{$tag});
1781	}
1782
1783	# $self-<{player}{tag} => player inv
1784	#use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1785	}
1786
1787	sub conn::container_clear {
1788	my ($self, $tag) = @_;
1789
1790	#d# print "container_clear: container $tag ($self->{player}{tag})\n";
1791
1792	if ($tag == 0) {
1793	update_floorbox;
1794	$OPENCONT = 0;
1795	$INVR_LBL->set_text ("Floor");
1796	$INVR->set_items ($self->{container}{0});
1797	} elsif ($tag == $self->{player}{tag}) {
1798	$INVR_LBL->set_text ("Player");
1799	$INV->set_items ($self->{container}{$tag})
1800	} else {
1801	$OPENCONT = $tag;
1802	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1803	$INVR->set_items ($self->{container}{$tag});
1804	}
1805
1806	# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1807	}
1808
1809	sub conn::item_delete {
1810	my ($self, @items) = @_;
1811
1812	for (@items) {
1813	#d# print "item_delete: $_->{tag} from $_->{container} ($self->{player}{tag})\n";
1814
1815	if ($_->{container} == 0) {
1816	update_floorbox;
1817	$OPENCONT = 0;
1818	$INVR_LBL->set_text ("Floor");
1819	$INVR->set_items ($self->{container}{0});
1820	} elsif ($_->{container} == $self->{player}{tag}) {
1821	$INVR_LBL->set_text ("Player");
1822	$INV->set_items ($self->{container}{$self->{player}{tag}})
1823	} else {
1824	$OPENCONT = $_->{container};
1825	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1826	$INVR->set_items ($self->{container}{$_->{container}});
1827	}
1828	}
1829	}
1830
1831	sub conn::item_update {
1832	my ($self, $item) = @_;
1833
1834	#d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($OPENCONT)\n";
1835
1836	if ($item->{tag} == $OPENCONT && not ($item->{flags} & Crossfire::Protocol::F_OPEN)) {
1837	$OPENCONT = 0;
1838	$INVR_LBL->set_text ("Floor");
1839	$INVR->set_items ($self->{container}{0});
1840
1841	$item->{widget}->update_item
1842	if $item->{widget};
1843	} else {
1844	if ($item->{container} == 0) {
1845	update_floorbox;
1846	$OPENCONT = 0;
1847	$INVR_LBL->set_text ("Floor");
1848	$INVR->set_items ($self->{container}{0});
1849	} elsif ($item->{container} == $self->{player}{tag}) {
1850	$INV->set_items ($self->{container}{$item->{container}})
1851	}
1852	}
1853	}
1854		1857
1855	%SDL_CB = (	1858	%SDL_CB = (
1856	CFClient::SDL_QUIT => sub {	1859	CFClient::SDL_QUIT => sub {
1857	Event::unloop -1;	1860	Event::unloop -1;
1858	},	1861	},
…		…
1890	#############################################################################	1893	#############################################################################
1891		1894
1892	$SIG{INT} = $SIG{TERM} = sub { exit };	1895	$SIG{INT} = $SIG{TERM} = sub { exit };
1893		1896
1894	{	1897	{
1895	local $SIG{__DIE__} = sub { CFClient::fatal $_[0] };	1898	local $SIG{__DIE__} = sub {
		1899	return unless defined $^S && !$^S;
		1900	Carp::confess $_[1];#d#TODO: remove when stable
		1901	CFClient::fatal $_[0];
		1902	};
1896		1903
1897	CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";	1904	CFClient::read_cfg "$Crossfire::VARDIR/cfplusrc";
1898		1905	CFClient::UI::set_layout ($::CFG->{layout});
1899	$TILECACHE = CFClient::db_table "tilecache";
1900	$FACEMAP = CFClient::db_table "facemap";
1901		1906
1902	my %DEF_CFG = (	1907	my %DEF_CFG = (
1903	sdl_mode => 0,	1908	sdl_mode => 0,
1904	width => 640,	1909	width => 640,
1905	height => 480,	1910	height => 480,
1906	fullscreen => 0,	1911	fullscreen => 0,
1907	fast => 0,	1912	fast => 0,
1908	map_scale => 1,	1913	map_scale => 1,
1909	fow_enable => 1,	1914	fow_enable => 1,
1910	fow_intensity => 0.45,	1915	fow_intensity => 0.45,
1911	fow_smooth => 0,	1916	fow_smooth => 0,
1912	gui_fontsize => 1,	1917	gui_fontsize => 1,
1913	log_fontsize => 1,	1918	log_fontsize => 0.7,
1914	gauge_fontsize=> 1,	1919	gauge_fontsize => 1,
1915	gauge_size => 0.35,	1920	gauge_size => 0.35,
1916	stat_fontsize => 1,	1921	stat_fontsize => 0.7,
1917	mapsize => 100,	1922	mapsize => 100,
1918	host => "crossfire.schmorp.de",
1919	say_command => 'say',	1923	say_command => 'say',
1920	audio_enable => 1,	1924	audio_enable => 1,
1921	bgm_enable => 1,	1925	bgm_enable => 1,
1922	bgm_volume => 0.25,	1926	bgm_volume => 0.25,
1923	face_prefetch => 0,	1927	face_prefetch => 0,
1924	output_sync => 1,	1928	output_sync => 1,
1925	output_count => 1,	1929	output_count => 1,
		1930	pickup => 0,
		1931	default => "profile", # default profile
		1932	);
1926	);	1933
1927
1928	while (my ($k, $v) = each %DEF_CFG) {	1934	while (my ($k, $v) = each %DEF_CFG) {
1929	$CFG->{$k} = $v unless exists $CFG->{$k};	1935	$CFG->{$k} = $v unless exists $CFG->{$k};
1930	}	1936	}
		1937
		1938	$CFG->{profile}{default}{host} ||= "crossfire.schmorp.de";
1931		1939
1932	sdl_init;	1940	sdl_init;
1933		1941
1934	@SDL_MODES = reverse	1942	@SDL_MODES = reverse
1935	grep $_->[0] >= 640 && $_->[1] >= 480,	1943	grep $_->[0] >= 640 && $_->[1] >= 480,
…		…
1977	video_init;	1985	video_init;
1978	audio_init;	1986	audio_init;
1979	}	1987	}
1980		1988
1981	Event::loop;	1989	Event::loop;
		1990	#CFClient::SDL_Quit;
		1991	#CFClient::_exit 0;
1982		1992
1983	END { CFClient::SDL_Quit }	1993	END { CFClient::SDL_Quit }
1984		1994
1985	=head1 NAME	1995	=head1 NAME
1986		1996
1987	pclient - A Crossfire+ and Crossfire game client	1997	cfplus - A Crossfire+ and Crossfire game client
1988		1998
1989	=head1 SYNOPSIS	1999	=head1 SYNOPSIS
1990		2000
1991	Just run it - no commandline arguments are supported.	2001	Just run it - no commandline arguments are supported.
1992		2002
1993	=head1 USAGE	2003	=head1 USAGE
1994		2004
1995	Pclient utilises OpenGL for all UI elements and the game. It is supposed to be used	2005	cfplus utilises OpenGL for all UI elements and the game. It is supposed to be used
1996	fullscreen and interactively.	2006	fullscreen and interactively.
1997		2007
		2008	=head1 DEBUGGING
		2009
		2010
		2011	CFPLUS_DEBUG - environment variable
		2012
		2013	1 draw borders around widgets
		2014	2 add low-level widget info to tooltips
		2015	4 show fps
		2016	8 suppress tooltips
		2017
1998	=head1 AUTHOR	2018	=head1 AUTHOR
1999		2019
2000	Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>	2020	Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
2001		2021
2002		2022

Diff Legend

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