ViewVC Help

View File | Revision Log | Show Annotations | Download File

/cvs/deliantra/Deliantra-Client/bin/cfplus

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

Diff Legend

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