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

Diff Legend

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