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.107 by root, Sun Aug 13 03:20:56 2006 UTC vs.
Revision 1.162 by root, Thu Jul 5 07:06:05 2007 UTC

1	#!/opt/bin/perl	1	#!/opt/bin/perl
		2
		3	my $startup_done = sub { };
		4	our $PANGO = "1.5.0";
		5
		6	# do splash-screen thingy on win32
		7	BEGIN {
		8	if (%PAR::LibCache && $^O eq "MSWin32") {
		9	while (my ($filename, $zip) = each %PAR::LibCache) {
		10	$zip->extractMember ("SPLASH.bmp", "$ENV{PAR_TEMP}/SPLASH.bmp");
		11	}
		12
		13	require Win32::GUI::SplashScreen;
		14
		15	Win32::GUI::SplashScreen::Show (
		16	-file => "$ENV{PAR_TEMP}/SPLASH.bmp",
		17	);
		18
		19	$startup_done = sub {
		20	Win32::GUI::SplashScreen::Done (1);
		21	};
		22	}
		23	}
2		24
3	use strict;	25	use strict;
4	use utf8;	26	use utf8;
		27
		28	use Carp 'verbose';
5		29
6	# do things only needed for single-binary version (par)	30	# do things only needed for single-binary version (par)
7	BEGIN {	31	BEGIN {
8	if (%PAR::LibCache) {	32	if (%PAR::LibCache) {
9	@INC = grep ref, @INC; # weed out all paths except pars loader refs	33	@INC = grep ref, @INC; # weed out all paths except pars loader refs
10		34
		35	my $tmp = $ENV{PAR_TEMP};
		36
11	while (my ($filename, $zip) = each %PAR::LibCache) {	37	while (my ($filename, $zip) = each %PAR::LibCache) {
12	for ($zip->memberNames) {	38	for ($zip->memberNames) {
13	next unless /^\/root\/(.*)/;	39	next unless /^root\/(.*)/;
14	$zip->extractMember ($_, "$ENV{PAR_TEMP}/$1")	40	$zip->extractMember ($_, "$tmp/$1")
15	unless -e "$ENV{PAR_TEMP}/$1";	41	unless -e "$tmp/$1";
16	}	42	}
17	}	43	}
18		44
19	# TODO: pango-rc file, anybody?	45	if ($^O eq "MSWin32") {
		46	# relocatable
		47	} else {
		48	# unix, need to patch pango rc file
		49	open my $fh, "<:perlio", "$tmp/usr/lib/pango/$PANGO/module-files.d/libpango1.0-0.modules"
		50	or die "$tmp/usr/lib/$PANGO/module-files.d/libpango1.0-0.modules: $!";
		51	local $/;
		52	my $rc = <$fh>;
		53	$rc =~ s/^\//$tmp\//gm; # replace abs paths by relative ones
20		54
21	unshift @INC, $ENV{PAR_TEMP};	55	mkdir "$tmp/pango-modules";
		56	open my $fh, ">:perlio", "$tmp/pango-modules/pango.modules"
		57	or die "$tmp/pango-modules/pango.modules: $!";
		58	print $fh $rc;
		59
		60	$ENV{PANGO_RC_FILE} = "$tmp/pango.rc";
		61	open my $fh, ">:perlio", $ENV{PANGO_RC_FILE}
		62	or die "$ENV{PANGO_RC_FILE}: $!";
		63	print $fh "[Pango]\nModuleFiles = $tmp/pango-modules\n";
		64	}
		65
		66	unshift @INC, $tmp;
22	}	67	}
23	}	68	}
24		69
25	# need to do it again because that pile of garbage called PAR nukes it before main	70	# need to do it again because that pile of garbage called PAR nukes it before main
26	unshift @INC, $ENV{PAR_TEMP}	71	unshift @INC, $ENV{PAR_TEMP}
…		…
35	use Compress::LZF;	80	use Compress::LZF;
36		81
37	use CFPlus;	82	use CFPlus;
38	use CFPlus::OpenGL ();	83	use CFPlus::OpenGL ();
39	use CFPlus::Protocol;	84	use CFPlus::Protocol;
		85	use CFPlus::DB;
40	use CFPlus::UI;	86	use CFPlus::UI;
		87	use CFPlus::UI::Inventory;
		88	use CFPlus::UI::SpellList;
41	use CFPlus::Pod;	89	use CFPlus::Pod;
42	use CFPlus::BindingEditor;
43	use CFPlus::MapWidget;	90	use CFPlus::MapWidget;
		91	use CFPlus::Macro;
44		92
45	$SIG{QUIT} = sub { Carp::cluck "QUIT" };	93	$SIG{QUIT} = sub { Carp::cluck "QUIT" };
46	$SIG{PIPE} = 'IGNORE';	94	$SIG{PIPE} = 'IGNORE';
47		95
48	$Event::Eval = 0;	96	$Event::Eval = 1;
49	$Event::DIED = sub {	97	$Event::DIED = sub {
50	# TODO: display dialog box or so	98	CFPlus::fatal Carp::longmess $_[1]
51	Carp::cluck $_[1];#d#TODO: remove when stable
52	CFPlus::error $_[1];
53	};	99	};
54
55	$SIG{__DIE__} = sub {
56	return if CFPlus::in_destruct;
57	Carp::cluck $_[0];
58	CFPlus::error $_[0];
59	return;#d#
60	#return unless defined $^S && !$^S;
61	$Event::DIED->(undef, $_[0]);
62	};
63
64	our $VERSION = '0.1';
65		100
66	my $MAX_FPS = 60;	101	my $MAX_FPS = 60;
67	my $MIN_FPS = 5; # unused as of yet	102	my $MIN_FPS = 5; # unused as of yet
68		103
69	our $META_SERVER = "crossfire.real-time.com:13326";	104	our $META_SERVER = "http://metaserver.schmorp.de/current.json";
70		105
71	our $LAST_REFRESH;	106	our $LAST_REFRESH;
72	our $NOW;	107	our $NOW;
73		108
74	our $CFG;	109	our $CFG;
75	our $CONN;	110	our $CONN;
		111	our $PROFILE; # current profile
76	our $FAST; # fast, low-quality mode, possibly useful for software-rendering	112	our $FAST; # fast, low-quality mode, possibly useful for software-rendering
77		113
78	our $WANT_REFRESH;	114	our $WANT_REFRESH;
79	our $CAN_REFRESH;	115	our $CAN_REFRESH;
80		116
…		…
111		147
112	our $INVENTORY_PAGE;	148	our $INVENTORY_PAGE;
113	our $STATS_PAGE;	149	our $STATS_PAGE;
114	our $SKILL_PAGE;	150	our $SKILL_PAGE;
115	our $SPELL_PAGE;	151	our $SPELL_PAGE;
		152	our $SPELL_LIST;
116		153
117	our $HELP_WINDOW;	154	our $HELP_WINDOW;
118	our $MESSAGE_WINDOW;	155	our $MESSAGE_WINDOW;
119	our $FLOORBOX;	156	our $FLOORBOX;
120	our $GAUGES;	157	our $GAUGES;
…		…
133		170
134	our $INV;	171	our $INV;
135	our $INVR;	172	our $INVR;
136	our $INV_RIGHT_HB;	173	our $INV_RIGHT_HB;
137		174
138	our $BIND_EDITOR;
139	our $BIND_UPD_CB;
140
141	our $PICKUP_CFG;	175	our $PICKUP_CFG;
		176
		177	our $IN_BUILD_MODE;
		178	our $BUILD_BUTTON;
142		179
143	sub status {	180	sub status {
144	$STATUSBOX->add (CFPlus::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);	181	$STATUSBOX->add (CFPlus::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
145	}	182	}
146		183
147	sub debug {	184	sub debug {
148	$DEBUG_STATUS->set_text ($_[0]);	185	$DEBUG_STATUS->set_text ($_[0]);
		186	}
		187
		188	sub message {
		189	my ($para) = @_;
		190
		191	my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
		192
		193	$para->{markup} = "<span foreground='#ffffff'>$time</span> $para->{markup}";
		194
		195	$LOGVIEW->add_paragraph ($para);
		196	$LOGVIEW->scroll_to_bottom;
149	}	197	}
150		198
151	sub destroy_query_dialog {	199	sub destroy_query_dialog {
152	(delete $_[0]{query_dialog})->destroy	200	(delete $_[0]{query_dialog})->destroy
153	if $_[0]{query_dialog};	201	if $_[0]{query_dialog};
154	}	202	}
155		203
		204	# FIXME: a very ugly hack to wait for stat update look below! #d#
		205	our $QUERY_TIMER; #d#
		206
156	# server query dialog	207	# server query dialog
157	sub server_query {	208	sub server_query {
158	my ($conn, $flags, $prompt) = @_;	209	my ($conn, $flags, $prompt) = @_;
159		210
		211	# FIXME: a very ugly hack to wait for stat update #d#
		212	if ($prompt =~ /roll new stats/ and not $conn->{stat_change_with}) {
		213	unless ($QUERY_TIMER) {
		214	$QUERY_TIMER =
		215	Event->timer (
		216	after => 1,
		217	cb => sub {
		218	server_query ($conn, $flags, $prompt, 1);
		219	$QUERY_TIMER = undef
		220	}
		221	);
		222	return;
		223	}
		224	}
		225
160	$conn->{query_dialog} = my $dialog = new CFPlus::UI::FancyFrame	226	$conn->{query_dialog} = my $dialog = new CFPlus::UI::Toplevel
161	x => "center",	227	x => "center",
162	y => "center",	228	y => "center",
163	title => "Server Query",	229	title => "Server Query",
164	child => my $vbox = new CFPlus::UI::VBox,	230	child => my $vbox = new CFPlus::UI::VBox,
165	;	231	;
166		232
167	my @dialog = my $label = new CFPlus::UI::Label	233	my @dialog = my $label = new CFPlus::UI::Label
168	max_w => $::WIDTH * 0.4,	234	max_w => $::WIDTH * 0.8,
169	ellipsise => 0,	235	ellipsise => 0,
170	text => $prompt;	236	text => $prompt;
171		237
172	if ($flags & CS_QUERY_YESNO) {	238	if ($flags & CS_QUERY_YESNO) {
173	push @dialog, my $hbox = new CFPlus::UI::HBox;	239	push @dialog, my $hbox = new CFPlus::UI::HBox;
…		…
190	);	256	);
191		257
192	$dialog->grab_focus;	258	$dialog->grab_focus;
193		259
194	} elsif ($flags & CS_QUERY_SINGLECHAR) {	260	} elsif ($flags & CS_QUERY_SINGLECHAR) {
195	$dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";
196
197	if ($prompt =~ /Now choose a character|Press any key for the next race/i) {	261	if ($prompt =~ /Now choose a character|Press any key for the next race/i) {
198	$MESSAGE_WINDOW->show;	262	$dialog->{tooltip} = "#charcreation_focus";
199		263
200	unshift @dialog, new CFPlus::UI::Label	264	unshift @dialog, new CFPlus::UI::Label
201	max_w => $::WIDTH * 0.4,	265	max_w => $::WIDTH * 0.8,
202	ellipsise => 0,	266	ellipsise => 0,
203	markup => "\nOr use your keyboard and the text entry below:\n";	267	markup => "\nOr use your keyboard and the text entry below:\n";
204		268
205	unshift @dialog, my $table = new CFPlus::UI::Table;	269	unshift @dialog, my $table = new CFPlus::UI::Table;
206		270
…		…
219	destroy_query_dialog $conn;	283	destroy_query_dialog $conn;
220	0	284	0
221	},	285	},
222	);	286	);
223		287
		288	if ($conn->{chargen_race_description}) {
		289	unshift @dialog, new CFPlus::UI::Label
		290	max_w => $::WIDTH * 0.8,
		291	ellipsise => 0,
		292	markup => "<span foreground='#ccccff'>$conn->{chargen_race_description}</span>",
		293	;
		294	}
		295
		296	unshift @dialog, new CFPlus::UI::Face
		297	face => $conn->{player}{face},
		298	bg => [.2, .2, .2, 1],
		299	min_w => 64,
		300	min_h => 64,
		301	;
		302
		303	if ($conn->{chargen_race_title}) {
		304	unshift @dialog, new CFPlus::UI::Label
		305	allign => 1,
		306	ellipsise => 0,
		307	markup => "<span foreground='#ccccff' size='large'>Race: $conn->{chargen_race_title}</span>",
		308	;
		309	}
		310
224	unshift @dialog, new CFPlus::UI::Label	311	unshift @dialog, new CFPlus::UI::Label
225	max_w => $::WIDTH * 0.4,	312	max_w => $::WIDTH * 0.4,
226	ellipsise => 0,	313	ellipsise => 0,
227	markup =>	314	markup => (CFPlus::Pod::section_label ui => "chargen_race"),
228	"<big><b>Character Creation: Race</b></big>\n\n"
229	. "Look at the <b>Messages</b> window to see a description of this race "
230	. "and the center of the screen to see how this race looks like "
231	. "(<small>below this dialog window: you may need to move the dialog away and "
232	. "click into the display area to make it visible</small>).\n\n"
233	. "You can look at another race, or accept this race (you will cycle back to "
234	. "this race eventually, so you can take your time making this important choice."
235	;	315	;
236		316
237	} elsif ($prompt =~ /roll new stats/) {	317	} elsif ($prompt =~ /roll new stats/) {
238	if (my $stat = delete $conn->{stat_change_with}) {	318	if (my $stat = delete $conn->{stat_change_with}) {
239	$conn->send ("reply $stat");	319	$conn->send ("reply $stat");
…		…
320	}	400	}
321		401
322	unshift @dialog, new CFPlus::UI::Label	402	unshift @dialog, new CFPlus::UI::Label
323	max_w => $::WIDTH * 0.4,	403	max_w => $::WIDTH * 0.4,
324	ellipsise => 0,	404	ellipsise => 0,
325	markup =>	405	markup => (CFPlus::Pod::section_label ui => "chargen_stats"),
326	"<big><b>Character Creation: Stats</b></big>\n\n"
327	. "<b>Stats</b> are a very important aspect of your character. You can use the tooltips to learn what each Stat governs.\n\n"
328	. "The stats generated by the server are always sorted from Str (highest) to Cha (lowest). "
329	. "They will be modified later by both the race and the class you choose.\n\n"
330	. "You can create another set of stats, swap two stat values with each other or accept the stats as shown below and continue.\n"
331	;	406	;
332	}	407	}
333		408
334	push @dialog, my $entry = new CFPlus::UI::Entry	409	push @dialog, my $entry = new CFPlus::UI::Entry
335	on_changed => sub {	410	on_changed => sub {
…		…
366	$LOGIN_BUTTON->set_text ("Logout");	441	$LOGIN_BUTTON->set_text ("Logout");
367	$SETUP_DIALOG->hide;	442	$SETUP_DIALOG->hide;
368		443
369	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;	444	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
370		445
371	my ($host, $port) = split /:/, $CFG->{profile}{default}{host};	446	my ($host, $port) = split /:/, $PROFILE->{host};
372		447
373	$MAP = new CFPlus::Map $mapsize, $mapsize;	448	$MAP = new CFPlus::Map;
374		449
375	$CONN = eval {	450	$CONN = eval {
376	new CFPlus::Protocol	451	new CFPlus::Protocol
377	host => $host,	452	host => $host,
378	port => $port || 13327,	453	port => $port || 13327,
379	user => $CFG->{profile}{default}{user},	454	user => $PROFILE->{user},
380	pass => $CFG->{profile}{default}{password},	455	pass => $PROFILE->{password},
381	mapw => $mapsize,	456	mapw => $mapsize,
382	maph => $mapsize,	457	maph => $mapsize,
		458
		459	client => "cfplus $CFPlus::VERSION $] $^O",
383		460
384	map_widget => $MAPWIDGET,	461	map_widget => $MAPWIDGET,
385	logview => $LOGVIEW,	462	logview => $LOGVIEW,
386	statusbox => $STATUSBOX,	463	statusbox => $STATUSBOX,
387	map => $MAP,	464	map => $MAP,
388	mapmap => $MAPMAP,	465	mapmap => $MAPMAP,
389	query => \&server_query,	466	query => \&server_query,
390		467
		468	setup_req => {
		469	smoothing => $CFG->{map_smoothing}*1,
		470	},
		471
391	sound_play => sub {	472	sound_play => sub {
392	my ($x, $y, $soundnum, $type) = @_;	473	my ($x, $y, $soundnum, $type) = @_;
393		474
394	$SDL_MIXER	475	$SDL_MIXER
395	or return;	476	or return;
…		…
414	sub stop_game {	495	sub stop_game {
415	$LOGIN_BUTTON->set_text ("Login");	496	$LOGIN_BUTTON->set_text ("Login");
416	$SETUP_NOTEBOOK->set_current_page ($SETUP_SERVER);	497	$SETUP_NOTEBOOK->set_current_page ($SETUP_SERVER);
417	$SETUP_DIALOG->show;	498	$SETUP_DIALOG->show;
418	$PL_WINDOW->hide;	499	$PL_WINDOW->hide;
419	$SPELL_PAGE->clear_spells;	500	$SPELL_LIST->clear_spells;
		501	$CFPlus::UI::ROOT->emit (stop_game => ! ! $CONN);
420		502
421	return unless $CONN;	503	return unless $CONN;
422		504
423	status "connection closed";	505	status "connection closed";
424		506
…		…
432	sub graphics_setup {	514	sub graphics_setup {
433	my $vbox = new CFPlus::UI::VBox;	515	my $vbox = new CFPlus::UI::VBox;
434		516
435	$vbox->add (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]);	517	$vbox->add (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]);
436		518
		519	my $row = 0;
		520
		521	$table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "OpenGL Info");
		522	$table->add (1, $row++, new CFPlus::UI::Label valign => 0, fontsize => 0.8, text => CFPlus::OpenGL::gl_vendor . ", " . CFPlus::OpenGL::gl_version,
		523	can_events => 1,
		524	tooltip => "<tt><span size='8192'>" . (CFPlus::OpenGL::gl_extensions) . "</span></tt>");
		525
437	$table->add (0, 0, new CFPlus::UI::Label valign => 0, align => 1, text => "Video Mode");	526	$table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Video Mode");
438	$table->add (1, 0, my $hbox = new CFPlus::UI::HBox);	527	$table->add (1, $row++, my $hbox = new CFPlus::UI::HBox);
439		528
440	$hbox->add (my $mode_slider = new CFPlus::UI::Slider force_w => $WIDTH * 0.1, expand => 1, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1]);	529	$hbox->add (my $mode_slider = new CFPlus::UI::Slider force_w => $WIDTH * 0.1, expand => 1, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1]);
441	$hbox->add (my $mode_label = new CFPlus::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");	530	$hbox->add (my $mode_label = new CFPlus::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");
442		531
443	$mode_slider->connect (changed => sub {	532	$mode_slider->connect (changed => sub {
…		…
445		534
446	$CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;	535	$CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
447	$mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});	536	$mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});
448	});	537	});
449	$mode_slider->emit (changed => $mode_slider->{range}[0]);	538	$mode_slider->emit (changed => $mode_slider->{range}[0]);
450
451	my $row = 1;
452		539
453	$table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fullscreen");	540	$table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fullscreen");
454	$table->add (1, $row++, $FULLSCREEN_ENABLE = new CFPlus::UI::CheckBox	541	$table->add (1, $row++, $FULLSCREEN_ENABLE = new CFPlus::UI::CheckBox
455	state => $CFG->{fullscreen},	542	state => $CFG->{fullscreen},
456	tooltip => "Bring the client into fullscreen mode.",	543	tooltip => "Bring the client into fullscreen mode.",
…		…
462	state => $CFG->{fast},	549	state => $CFG->{fast},
463	tooltip => "Lower the visual quality considerably to speed up rendering.",	550	tooltip => "Lower the visual quality considerably to speed up rendering.",
464	on_changed => sub { my ($self, $value) = @_; $CFG->{fast} = $value; 0 }	551	on_changed => sub { my ($self, $value) = @_; $CFG->{fast} = $value; 0 }
465	);	552	);
466		553
		554	$table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
		555	$table->add (1, $row++, new CFPlus::UI::Slider
		556	range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],
		557	tooltip => "The base font size used by most GUI elements that do not have their own setting.",
		558	on_changed => sub { $CFG->{gui_fontsize} = $_[1]; 0 },
		559	);
		560
		561	$table->add (1, $row++, new CFPlus::UI::Button
		562	expand => 1, align => 0, text => "Apply",
		563	tooltip => "Apply the video settings above.",
		564	on_activate => sub {
		565	video_shutdown ();
		566	video_init ();
		567	0
		568	}
		569	);
		570
467	$table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Scale");	571	$table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Scale");
468	$table->add (1, $row++, new CFPlus::UI::Slider	572	$table->add (1, $row++, new CFPlus::UI::Slider
469	range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],	573	range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
470	tooltip => "Enlarge or shrink the displayed map. Changes are instant.",	574	tooltip => "Enlarge or shrink the displayed map. Changes are instant.",
471	on_changed => sub { my ($self, $value) = @_; $CFG->{map_scale} = 2 ** $value; 0 }	575	on_changed => sub { my ($self, $value) = @_; $CFG->{map_scale} = 2 ** $value; 0 }
		576	);
		577
		578	$table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Smoothing");
		579	$table->add (1, $row++, new CFPlus::UI::CheckBox
		580	state => $CFG->{map_smoothing},
		581	tooltip => "<b>Map Smoothing</b> tries to make tile borders less square. "
		582	. "This increases load on the graphics subsystem and works only with 2.x servers. "
		583	. "Changes take effect at next connection only.",
		584	on_changed => sub { my ($self, $value) = @_; $CFG->{map_smoothing} = $value; 0 }
472	);	585	);
473		586
474	$table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fog of War");	587	$table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fog of War");
475	$table->add (1, $row++, new CFPlus::UI::CheckBox	588	$table->add (1, $row++, new CFPlus::UI::CheckBox
476	state => $CFG->{fow_enable},	589	state => $CFG->{fow_enable},
…		…
495	status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFPlus::OpenGL::GL_VERSION < 1.2;	608	status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFPlus::OpenGL::GL_VERSION < 1.2;
496	0	609	0
497	}	610	}
498	);	611	);
499		612
500	$table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
501	$table->add (1, $row++, new CFPlus::UI::Slider
502	range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],
503	tooltip => "The base font size used by most GUI elements that do not have their own setting.",
504	on_changed => sub { $CFG->{gui_fontsize} = $_[1]; 0 },
505	);
506
507	$table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Message Fontsize");	613	$table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Message Fontsize");
508	$table->add (1, $row++, new CFPlus::UI::Slider	614	$table->add (1, $row++, new CFPlus::UI::Slider
509	range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],	615	range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],
510	tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant.",	616	tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant.",
511	on_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]); 0 },	617	on_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]); 0 },
…		…
527	range => [$CFG->{gauge_size}, 0.2, 0.8],	633	range => [$CFG->{gauge_size}, 0.2, 0.8],
528	tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",	634	tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",
529	on_changed => sub {	635	on_changed => sub {
530	$CFG->{gauge_size} = $_[1];	636	$CFG->{gauge_size} = $_[1];
531	$GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});	637	$GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
532	0
533	}
534	);
535
536	$table->add (1, $row++, new CFPlus::UI::Button
537	expand => 1, align => 0, text => "Apply",
538	tooltip => "Apply the video settings",
539	on_activate => sub {
540	video_shutdown ();
541	video_init ();
542	0	638	0
543	}	639	}
544	);	640	);
545		641
546	$vbox	642	$vbox
…		…
622	(new CFPlus::UI::Empty expand => 1),	718	(new CFPlus::UI::Empty expand => 1),
623	(my $hb = new CFPlus::UI::HBox),	719	(my $hb = new CFPlus::UI::HBox),
624	],	720	],
625	);	721	);
626		722
627	$hb->add (my $hg = new CFPlus::UI::Gauge type => 'hp',	723	$hb->add (my $hg = new CFPlus::UI::Gauge type => 'hp', tooltip => "#stat_health");
628	tooltip => "<b>Health points</b>. Measures of how much damage you can take before dying. Hit points are determined from your level and are influenced by the value of your Con. Hp value may range between 1 to beyond 500 and higher values indicate a greater ability to withstand punishment.");
629	$hb->add (my $mg = new CFPlus::UI::Gauge type => 'mana',	724	$hb->add (my $mg = new CFPlus::UI::Gauge type => 'mana', tooltip => "#stat_mana");
630	tooltip => "<b>Spell points</b>. Measures of how much \"fuel\" you have for casting spells and incantations. Mana is calculated from your level and your Pow. Mana values can range between 1 to beyond 500 (glowing crystals can increase the current spell points beyond your normal maximum). Higher values indicate greater amounts of mana.");
631	$hb->add (my $gg = new CFPlus::UI::Gauge type => 'grace',	725	$hb->add (my $gg = new CFPlus::UI::Gauge type => 'grace', tooltip => "#stat_grace");
632	tooltip => "<b>Grace points</b> - how favored you are by your god. In game terms, how much divine magic you can cast. Your level, Wis and Pow effect what the value of grace is. Prayong on an altar of your god can increase this value beyond your normal maximum. Grace can take on large positive and negative values. Positive values indicate favor by the gods.");
633	$hb->add (my $fg = new CFPlus::UI::Gauge type => 'food',	726	$hb->add (my $fg = new CFPlus::UI::Gauge type => 'food', tooltip => "#stat_food");
634	tooltip => "<b>Food</b>. Ranges between 0 (starving) and 999 (satiated). At a value of 0 the character begins to die. Some magic can speed up or slow down the character digestion. Healing wounds will speed up digestion too.");
635		727
636	$vbox->add (my $exp = new CFPlus::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,	728	$vbox->add (my $exp = new CFPlus::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1, tooltip => "#stat_exp");
637	tooltip => "<b>Experience points and overall level</b> - experience is increased as a reward for appropriate action (such as killing monsters) and may decrease as a result of a magical attack or dying. Level is directly derived from the experience value. As the level of the character increases, the character becomes able to succeed at more difficult tasks. A character's level starts at a value of 0 and may range up beyond 100.");
638	$vbox->add (my $rng = new CFPlus::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,	729	$vbox->add (my $rng = new CFPlus::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1, tooltip => "#stat_ranged");
639	tooltip => "<b>Ranged attack</b> - how you attack when you press shift-cursor (spell, skill, weapon etc.)");
640		730
641	$GAUGES = {	731	$GAUGES = {
642	exp => $exp, win => $win, range => $rng,	732	exp => $exp, win => $win, range => $rng,
643	food => $fg, mana => $mg, hp => $hg, grace => $gg	733	food => $fg, mana => $mg, hp => $hg, grace => $gg
644	};	734	};
…		…
657	$table->add (1, 1, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 2; 0 });	747	$table->add (1, 1, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 2; 0 });
658	$table->add (0, 2, new CFPlus::UI::Label text => "Show FPS");	748	$table->add (0, 2, new CFPlus::UI::Label text => "Show FPS");
659	$table->add (1, 2, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 4; 0 });	749	$table->add (1, 2, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 4; 0 });
660	$table->add (0, 3, new CFPlus::UI::Label text => "Suppress Tooltips");	750	$table->add (0, 3, new CFPlus::UI::Label text => "Suppress Tooltips");
661	$table->add (1, 3, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 8; 0 });	751	$table->add (1, 3, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 8; 0 });
		752	$table->add (0, 4, new CFPlus::UI::Button text => "die on click(tm)", on_activate => sub { &CFPlus::debug() } );
662		753
663	my @default_smooth = (0.05, 0.13, 0.05, 0.13, 0.30, 0.13, 0.05, 0.13, 0.05);	754	my @default_smooth = (0.05, 0.13, 0.05, 0.13, 0.30, 0.13, 0.05, 0.13, 0.05);
664		755
665	for my $x (0..2) {	756	for my $x (0..2) {
666	for my $y (0 .. 2) {	757	for my $y (0 .. 2) {
…		…
670	on_changed => sub { $MAP->{smooth_matrix}[$x * 3 + $y] = $_[1] if $MAP; 0 },	761	on_changed => sub { $MAP->{smooth_matrix}[$x * 3 + $y] = $_[1] if $MAP; 0 },
671	);	762	);
672	}	763	}
673	}	764	}
674		765
		766	$table->add (0, 5, new CFPlus::UI::TextEdit text => "line1\0152\0153");#d#
675		767
676	$table	768	$table
677	}	769	}
678		770
679	sub stats_window {	771	sub stats_window {
…		…
681	expand => 1,	773	expand => 1,
682	scroll_y => 1	774	scroll_y => 1
683	);	775	);
684	$r->add (my $vb = new CFPlus::UI::VBox);	776	$r->add (my $vb = new CFPlus::UI::VBox);
685		777
		778	$vb->add (new CFPlus::UI::FancyFrame
		779	label => "Player",
		780	child => (my $pi = new CFPlus::UI::VBox),
		781	);
		782
686	$vb->add ($STATWIDS->{title} = new CFPlus::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,	783	$pi->add ($STATWIDS->{title} = new CFPlus::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,
687	can_hover => 1, can_events => 1,	784	can_hover => 1, can_events => 1,
688	tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");	785	tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");
689	$vb->add ($STATWIDS->{map} = new CFPlus::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,	786	$pi->add ($STATWIDS->{map} = new CFPlus::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,
690	can_hover => 1, can_events => 1,	787	can_hover => 1, can_events => 1,
691	tooltip => "The map you are currently on (if supported by the server).");	788	tooltip => "The map you are currently on (if supported by the server).");
692		789
693	$vb->add (my $hb0 = new CFPlus::UI::HBox);	790	$pi->add (my $hb0 = new CFPlus::UI::HBox);
694	$hb0->add ($STATWIDS->{weight} = new CFPlus::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1,	791	$hb0->add ($STATWIDS->{weight} = new CFPlus::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1,
695	can_hover => 1, can_events => 1,	792	can_hover => 1, can_events => 1,
696	tooltip => "The weight of the player including all inventory items.");	793	tooltip => "The weight of the player including all inventory items.");
697	$hb0->add ($STATWIDS->{m_weight} = new CFPlus::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1,	794	$hb0->add ($STATWIDS->{m_weight} = new CFPlus::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1,
698	can_hover => 1, can_events => 1,	795	can_hover => 1, can_events => 1,
699	tooltip => "The weight limit: you cannot carry more than this.");	796	tooltip => "The weight limit: you cannot carry more than this.");
700		797
		798	$vb->add (new CFPlus::UI::FancyFrame
		799	label => "Primary/Secondary Statistics",
701	$vb->add (my $hb = new CFPlus::UI::HBox expand => 1);	800	child => (my $hb = new CFPlus::UI::HBox expand => 1),
		801	);
702	$hb->add (my $tbl = new CFPlus::UI::Table expand => 1);	802	$hb->add (my $tbl = new CFPlus::UI::Table expand => 1);
703		803
704	my $color2 = [1, 1, 0];	804	my $color2 = [1, 1, 0];
705		805
706	for (	806	for (
…		…
727	$tbl->add ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFPlus::UI::Label	827	$tbl->add ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFPlus::UI::Label
728	font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $color2, valign => 0,	828	font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $color2, valign => 0,
729	align => -1, text => $label, tooltip => "#stat_$label");	829	align => -1, text => $label, tooltip => "#stat_$label");
730	}	830	}
731		831
		832	$vb->add (new CFPlus::UI::FancyFrame
		833	label => "Resistancies",
732	$vb->add (my $tbl2 = new CFPlus::UI::Table expand => 1);	834	child => (my $tbl2 = new CFPlus::UI::Table expand => 1),
		835	);
733		836
734	my $row = 0;	837	my $row = 0;
735	my $col = 0;	838	my $col = 0;
736		839
737	my %resist_names = (	840	my %resist_names = (
…		…
837		940
838	my $table = $METASERVER->{table};	941	my $table = $METASERVER->{table};
839	$table->clear;	942	$table->clear;
840	$table->add (0, 0, my $label = new CFPlus::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");	943	$table->add (0, 0, my $label = new CFPlus::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
841		944
842	my $buf;	945	my $ok = 0;
843		946
844	my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;	947	CFPlus::background {
		948	my $ua = CFPlus::lwp_useragent;
845		949
846	unless ($fh) {	950	CFPlus::background_msg CFPlus::from_json +(CFPlus::lwp_check $ua->get ($META_SERVER))->decoded_content;
847	$label->set_text ("unable to contact metaserver: $!");	951	} sub {
848	return;	952	my ($msg) = @_;
849	}	953	if ($msg) {
850
851	Event->io (fd => $fh, poll => 'r', cb => sub {
852	my $res = sysread $fh, $buf, 8192, length $buf;
853
854	if (!defined $res) {
855	$_[0]->w->cancel;
856	$label->set_text ("error while retrieving server list: $!");
857	} elsif ($res == 0) {
858	$_[0]->w->cancel;
859	status "server list retrieved";
860
861	utf8::decode $buf if utf8::valid $buf;
862
863	$table->clear;	954	$table->clear;
864		955
865	my @tip = (	956	my @tip = (
866	"The current number of users logged in on the server.",	957	"The current number of users logged in on the server.",
867	"The hostname of the server.",	958	"The hostname of the server.",
…		…
877	for 0 .. $#col;	968	for 0 .. $#col;
878		969
879	my @align = qw(1 0 1 1 -1);	970	my @align = qw(1 0 1 1 -1);
880		971
881	my $y = 0;	972	my $y = 0;
882	for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) {	973	for my $m (@{ $msg->{servers} }) {
883	my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m;	974	my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime, $highlight) =
		975	@$m{qw(ip age hostname users version description ibytes obytes uptime highlight)};
884		976
885	for ($desc) {	977	for ($desc) {
886	s/<br>/\n/gi;	978	s/<br>/\n/gi;
887	s/<li>/\n· /gi;	979	s/<li>/\n· /gi;
888	s/<.*?>//sgi;	980	s/<.*?>//sgi;
889	s/&/&amp;/g;	981	s/&amp;/&/g;
890	s/</&lt;/g;	982	s/&lt;/</g;
891	s/>/&gt;/g;	983	s/&gt;/>/g;
892	}	984	}
893		985
894	$uptime = sprintf "%dd %02d:%02d:%02d",	986	$uptime = sprintf "%dd %02d:%02d:%02d",
895	(int $m->[8] / 86400),	987	(int $uptime / 86400),
896	(int $m->[8] / 3600) % 24,	988	(int $uptime / 3600) % 24,
897	(int $m->[8] / 60) % 60,	989	(int $uptime / 60) % 60,
898	$m->[8] % 60;	990	$uptime % 60;
899		991
900	$m = [$users, $host, $uptime, $version, $desc];	992	$m = [$users, $host, $uptime, $version, $desc];
901		993
902	$y++;	994	$y++;
903		995
…		…
913	),	1005	),
914	(new CFPlus::UI::Empty expand => 1),	1006	(new CFPlus::UI::Empty expand => 1),
915	]);	1007	]);
916		1008
917	$table->add ($_, $y, new CFPlus::UI::Label	1009	$table->add ($_, $y, new CFPlus::UI::Label
		1010	max_w => $::WIDTH * 0.4,
918	ellipsise => 0,	1011	ellipsise => 0,
919	align => $align[$_],	1012	align => $align[$_],
920	text => $m->[$_],	1013	text => $m->[$_],
921	tooltip => $tip[$_],	1014	tooltip => $tip[$_],
		1015	fg => ($highlight ? [1, 1, 1] : [.7, .7, .7]),
922	can_hover => 1,	1016	can_hover => 1,
923	can_events => 1,	1017	can_events => 1,
924	fontsize => 0.8)	1018	fontsize => 0.8)
925	for 0 .. $#$m;	1019	for 0 .. $#$m;
926	}	1020	}
		1021	} else {
		1022	$ok or $label->set_text ("error while contacting metaserver");
927	}	1023	}
928	});	1024	};
		1025
929	}	1026	}
930		1027
931	sub metaserver_dialog {	1028	sub metaserver_dialog {
932	my $vbox = new CFPlus::UI::VBox;	1029	my $vbox = new CFPlus::UI::VBox;
933	my $table = new CFPlus::UI::Table;	1030	my $table = new CFPlus::UI::Table;
934	$vbox->add (new CFPlus::UI::ScrolledWindow expand => 1, child => $table);	1031	$vbox->add (new CFPlus::UI::ScrolledWindow expand => 1, child => $table);
935		1032
936	my $dialog = new CFPlus::UI::FancyFrame	1033	my $dialog = new CFPlus::UI::Toplevel
937	title => "Server List",	1034	title => "Server List",
938	name => 'metaserver_dialog',	1035	name => 'metaserver_dialog',
939	x => 'center',	1036	x => 'center',
940	y => 'center',	1037	y => 'center',
941	z => 3,	1038	z => 3,
		1039	force_w => $::WIDTH * 0.9,
942	force_h => $::HEIGHT * 0.4,	1040	force_h => $::HEIGHT * 0.7,
943	child => $vbox,	1041	child => $vbox,
944	has_close_button => 1,	1042	has_close_button => 1,
945	table => $table,	1043	table => $table,
946	on_visibility_change => sub {	1044	on_visibility_change => sub {
947	update_metaserver ($_[0]) if $_[1];	1045	update_metaserver ($_[0]) if $_[1];
…		…
953	}	1051	}
954		1052
955	sub server_setup {	1053	sub server_setup {
956	my $vbox = new CFPlus::UI::VBox;	1054	my $vbox = new CFPlus::UI::VBox;
957		1055
		1056	$vbox->add (new CFPlus::UI::FancyFrame
		1057	label => "Connection Settings",
958	$vbox->add (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]);	1058	child => (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]),
		1059	);
959	$table->add (0, 2, new CFPlus::UI::Label valign => 0, align => 1, text => "Host:Port");	1060	$table->add (0, 2, new CFPlus::UI::Label valign => 0, align => 1, text => "Host:Port");
960		1061
961	{	1062	{
962	$table->add (1, 2, my $vbox = new CFPlus::UI::VBox);	1063	$table->add (1, 2, my $vbox = new CFPlus::UI::VBox);
963		1064
…		…
1020	. "so only set it if you really need to prefetch images. "	1121	. "so only set it if you really need to prefetch images. "
1021	. "This option can be set and unset any time.",	1122	. "This option can be set and unset any time.",
1022	on_changed => sub { $CFG->{face_prefetch} = $_[1]; 0 },	1123	on_changed => sub { $CFG->{face_prefetch} = $_[1]; 0 },
1023	);	1124	);
1024		1125
1025	$table->add (0, 9, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Count");	1126	$table->add (0, 9, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Rate");
1026	$table->add (1, 9, new CFPlus::UI::Entry	1127	$table->add (1, 9, new CFPlus::UI::Entry
		1128	text => $CFG->{output_rate},
		1129	tooltip => "The approximate bandwidth in bytes per second that the server should not exceed "
		1130	. "when sending images, to ensure interactiveness. When 0 or unset, the server "
		1131	. "default will be used, which is usually around 100kb/s.",
		1132	on_changed => sub { $CFG->{output_rate} = $_[1]; 0 },
		1133	);
		1134
		1135	$table->add (0, 10, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Count");
		1136	$table->add (1, 10, new CFPlus::UI::Entry
1027	text => $CFG->{output_count},	1137	text => $CFG->{output_count},
1028	tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",	1138	tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
1029	on_changed => sub { $CFG->{output_count} = $_[1]; 0 },	1139	on_changed => sub { $CFG->{output_count} = $_[1]; 0 },
1030	);	1140	);
1031		1141
1032	$table->add (0, 10, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Sync");	1142	$table->add (0, 11, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Sync");
1033	$table->add (1, 10, new CFPlus::UI::Entry	1143	$table->add (1, 11, new CFPlus::UI::Entry
1034	text => $CFG->{output_sync},	1144	text => $CFG->{output_sync},
1035	tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",	1145	tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
1036	on_changed => sub { $CFG->{output_sync} = $_[1]; 0 },	1146	on_changed => sub { $CFG->{output_sync} = $_[1]; 0 },
1037	);	1147	);
1038		1148
1039	$table->add (1, 11, $LOGIN_BUTTON = new CFPlus::UI::Button	1149	$table->add (1, 12, $LOGIN_BUTTON = new CFPlus::UI::Button
1040	expand => 1,	1150	expand => 1,
1041	align => 0,	1151	align => 0,
1042	text => "Login",	1152	text => "Login",
1043	on_activate => sub {	1153	on_activate => sub {
1044	$CONN ? stop_game	1154	$CONN ? stop_game
1045	: start_game;	1155	: start_game;
1046	0	1156	0
1047	},	1157	},
1048	);	1158	);
1049		1159
		1160	$vbox->add (new CFPlus::UI::FancyFrame
		1161	label => "Server Info",
		1162	child => ($SERVER_INFO = new CFPlus::UI::Label ellipsise => 0),
		1163	);
		1164
		1165	$vbox
		1166	}
		1167
		1168	sub client_setup {
		1169	my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1];
		1170
		1171	my $row = 0;
		1172
1050	$table->add (0, 12, new CFPlus::UI::Label valign => 0, align => 1, text => "Chat Command");	1173	$table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Chat Command");
1051	$table->add (1, 12, my $saycmd = new CFPlus::UI::Entry	1174	$table->add (1, $row++, my $saycmd = new CFPlus::UI::Entry
1052	text => $CFG->{say_command},	1175	text => $CFG->{say_command},
1053	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. "	1176	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. "
1054	. "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "	1177	. "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
1055	. "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",	1178	. "But you could also set it to <b>tell <i>playername</i></b> to only chat with that user.",
1056	on_changed => sub {	1179	on_changed => sub {
1057	my ($self, $value) = @_;	1180	my ($self, $value) = @_;
1058	$CFG->{say_command} = $value;	1181	$CFG->{say_command} = $value;
1059	0	1182	0
1060	}	1183	}
1061	);	1184	);
1062		1185
1063	$vbox->add (new CFPlus::UI::Label	1186	$table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Tip of the day");
1064	text => "Server Info",	1187	$table->add (1, $row++, new CFPlus::UI::CheckBox
1065	fontsize => 1.2,	1188	state => $CFG->{show_tips},
1066	padding_y => 8,	1189	tooltip => "Show the <b>Tip of the day</b> window at startup?",
1067	fg => [1, 1, 0, 1],	1190	on_changed => sub {
		1191	my ($self, $value) = @_;
		1192	$CFG->{show_tips} = $value;
		1193	0
		1194	}
1068	);	1195	);
1069		1196
1070	$vbox->add ($SERVER_INFO = new CFPlus::UI::Label ellipsise => 0);	1197	$table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Messages Window Size");
		1198	$table->add (1, $row++, my $saycmd = new CFPlus::UI::Entry
		1199	text => $CFG->{logview_max_par},
		1200	tooltip => "This is maximum number of messages remembered in the <b>Messages</b> window. If the server "
		1201	. "sends more messages than this number, older messages get removed to save memory and "
		1202	. "computing time. A value of <b>0</b> disables this feature, but that is not recommended.",
		1203	on_changed => sub {
		1204	my ($self, $value) = @_;
		1205	$LOGVIEW->{max_par} = $CFG->{logview_max_par} = $value*1;
		1206	0
		1207	},
		1208	);
1071		1209
1072	$vbox	1210	$table
1073	}	1211	}
1074		1212
1075	sub message_window {	1213	sub message_window {
1076	my $window = new CFPlus::UI::FancyFrame	1214	my $window = new CFPlus::UI::Toplevel
1077	name => "message_window",	1215	name => "message_window",
1078	title => "Messages",	1216	title => "Messages",
1079	border_bg => [1, 1, 1, 1],	1217	border_bg => [1, 1, 1, 1],
1080	x => "max",	1218	x => "max",
1081	y => 0,	1219	y => 0,
…		…
1131	window => $window,	1269	window => $window,
1132	input => $input,	1270	input => $input,
1133	};	1271	};
1134		1272
1135	$window	1273	$window
1136	}
1137
1138	sub open_string_query {
1139	my $cb = $_[1];
1140	my $dialog = new CFPlus::UI::FancyFrame
1141	x => "center",
1142	y => "center",
1143	z => 50,
1144	force_w => $WIDTH * 4/5,
1145	title => $_[0];
1146
1147	$dialog->add (
1148	my $e = new CFPlus::UI::Entry
1149	on_activate => sub { $cb->(@_); $dialog->hide; 0 },
1150	on_key_down => sub { $_[1]->{sym} == 27 and $dialog->hide; 0 },
1151	);
1152
1153	$e->grab_focus;
1154	$dialog->show;
1155	}
1156
1157	sub open_quit_dialog {
1158	unless ($QUIT_DIALOG) {
1159	$QUIT_DIALOG = new CFPlus::UI::FancyFrame
1160	x => "center",
1161	y => "center",
1162	z => 50,
1163	title => "Really Quit?",
1164	on_key_down => sub {
1165	my ($dialog, $ev) = @_;
1166	$ev->{sym} == 27 and $dialog->hide;
1167	}
1168	;
1169
1170	$QUIT_DIALOG->add (my $vb = new CFPlus::UI::VBox expand => 1);
1171
1172	$vb->add (new CFPlus::UI::Label
1173	text => "You should find a savebed and apply it first!",
1174	max_w => $WIDTH * 0.25,
1175	ellipsize => 0,
1176	);
1177	$vb->add (my $hb = new CFPlus::UI::HBox expand => 1);
1178	$hb->add (new CFPlus::UI::Button
1179	text => "Ok",
1180	expand => 1,
1181	on_activate => sub { $QUIT_DIALOG->hide; 0 },
1182	);
1183	$hb->add (new CFPlus::UI::Button
1184	text => "Quit anyway",
1185	expand => 1,
1186	on_activate => sub { exit },
1187	);
1188	}
1189
1190	$QUIT_DIALOG->show;
1191	$QUIT_DIALOG->grab_focus;
1192	}	1274	}
1193		1275
1194	sub autopickup_setup {	1276	sub autopickup_setup {
1195	my $table = new CFPlus::UI::Table;	1277	my $table = new CFPlus::UI::Table;
1196		1278
…		…
1214	["Boots" => PICKUP_BOOTS],	1296	["Boots" => PICKUP_BOOTS],
1215	["Gloves" => PICKUP_GLOVES],	1297	["Gloves" => PICKUP_GLOVES],
1216	["Cloaks" => PICKUP_CLOAK],	1298	["Cloaks" => PICKUP_CLOAK],
1217	],	1299	],
1218		1300
1219	["Readables", 2, 2,	1301	["Readables", 2, 0,
1220	["Spellbooks" => PICKUP_SPELLBOOK],	1302	["Spellbooks" => PICKUP_SPELLBOOK],
1221	["Skillscrolls" => PICKUP_SKILLSCROLL],	1303	["Skillscrolls" => PICKUP_SKILLSCROLL],
1222	["Normal Books/Scrolls" => PICKUP_READABLES],	1304	["Normal Books/Scrolls" => PICKUP_READABLES],
1223	],	1305	],
1224	["Misc", 2, 7,	1306	["Misc", 2, 5,
1225	["Food" => PICKUP_FOOD],	1307	["Food" => PICKUP_FOOD],
1226	["Drinks" => PICKUP_DRINK],	1308	["Drinks" => PICKUP_DRINK],
1227	["Valuables (Money, Gems)" => PICKUP_VALUABLES],	1309	["Valuables (Money, Gems)" => PICKUP_VALUABLES],
1228	["Keys" => PICKUP_KEY],	1310	["Keys" => PICKUP_KEY],
1229	["Magical Items" => PICKUP_MAGICAL],	1311	["Magical Items" => PICKUP_MAGICAL],
1230	["Potions" => PICKUP_POTION],	1312	["Potions" => PICKUP_POTION],
1231	["Magic Devices" => PICKUP_MAGIC_DEVICE],	1313	["Magic Devices" => PICKUP_MAGIC_DEVICE],
1232	["Ignore cursed" => PICKUP_NOT_CURSED],	1314	["Ignore cursed" => PICKUP_NOT_CURSED],
1233	["Jewelery" => PICKUP_JEWELS],	1315	["Jewelery" => PICKUP_JEWELS],
		1316	["Flesh" => PICKUP_FLESH],
1234	],	1317	],
1235	["Weight/Value ratio", 2, 17]	1318	["Weight/Value ratio", 2, 17]
1236	)	1319	)
1237	{	1320	{
1238	my ($title, $x, $y, @bits) = @$_;	1321	my ($title, $x, $y, @bits) = @$_;
…		…
1288	$table	1371	$table
1289	}	1372	}
1290		1373
1291	my %SORT_ORDER = (	1374	my %SORT_ORDER = (
1292	type => undef,	1375	type => undef,
1293	mtime => sub { sort {	1376	mtime => sub {
		1377	my $NOW = time;
		1378	sort {
		1379	my $atime = $a->{mtime} - $NOW; $atime = $atime < 5 * 60 ? int $atime / 60 : 6;
		1380	my $btime = $b->{mtime} - $NOW; $btime = $btime < 5 * 60 ? int $btime / 60 : 6;
		1381
1294	($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED)	1382	($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED)
1295	or $b->{mtime} <=> $a->{mtime}	1383	or $btime <=> $atime
1296	or $a->{type} <=> $b->{type}	1384	or $a->{type} <=> $b->{type}
		1385	} @_
1297	} @_ },	1386	},
1298	weight => sub { sort {	1387	weight => sub { sort {
1299	$a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1)	1388	$a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1)
1300	or $a->{type} <=> $b->{type}	1389	or $a->{type} <=> $b->{type}
1301	} @_ },	1390	} @_ },
1302	);	1391	);
…		…
1327	#TODO# update to weigh/maxweight	1416	#TODO# update to weigh/maxweight
1328	$hb1->add ($STATWIDS->{i_weight} = new CFPlus::UI::Label align => -1);	1417	$hb1->add ($STATWIDS->{i_weight} = new CFPlus::UI::Label align => -1);
1329		1418
1330	$vb1->add (my $sw1 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);	1419	$vb1->add (my $sw1 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);
1331	$sw1->add ($INV = new CFPlus::UI::Inventory);	1420	$sw1->add ($INV = new CFPlus::UI::Inventory);
		1421	$INV->set_sort_order ($SORT_ORDER{$::CFG->{inv_sort}});
1332		1422
1333	$hb->add (my $vb2 = new CFPlus::UI::VBox);	1423	$hb->add (my $vb2 = new CFPlus::UI::VBox);
1334		1424
1335	$vb2->add ($INV_RIGHT_HB = new CFPlus::UI::HBox);	1425	$vb2->add ($INV_RIGHT_HB = new CFPlus::UI::HBox);
1336		1426
…		…
1353	$PL_WINDOW->show;	1443	$PL_WINDOW->show;
1354	}	1444	}
1355	}	1445	}
1356		1446
1357	sub player_window {	1447	sub player_window {
1358	my $plwin = $PL_WINDOW = new CFPlus::UI::FancyFrame	1448	my $plwin = $PL_WINDOW = new CFPlus::UI::Toplevel
1359	x => "center",	1449	x => "center",
1360	y => "center",	1450	y => "center",
1361	force_w => $WIDTH * 9/10,	1451	force_w => $WIDTH * 9/10,
1362	force_h => $HEIGHT * 9/10,	1452	force_h => $HEIGHT * 9/10,
1363	title => "Player",	1453	title => "Player",
…		…
1365	has_close_button => 1	1455	has_close_button => 1
1366	;	1456	;
1367		1457
1368	my $ntb =	1458	my $ntb =
1369	$PL_NOTEBOOK =	1459	$PL_NOTEBOOK =
1370	new CFPlus::UI::Notebook expand => 1, debug => 1;	1460	new CFPlus::UI::Notebook expand => 1;
1371		1461
1372	$ntb->add (	1462	$ntb->add (
1373	"Statistics (F2)" => $STATS_PAGE = stats_window,	1463	"Statistics (F2)" => $STATS_PAGE = stats_window,
1374	"Shows statistics, where all your Stats and Resistances are shown."	1464	"Shows statistics, where all your Stats and Resistances are shown."
1375	);	1465	);
1376	$ntb->add (	1466	$ntb->add (
1377	"Skills (F3)" => $SKILL_PAGE = skill_window,	1467	"Skills (F3)" => $SKILL_PAGE = skill_window,
1378	"Shows all your Skills."	1468	"Shows all your Skills."
1379	);	1469	);
1380		1470
1381	my $spellsw = new CFPlus::UI::ScrolledWindow (expand => 1, scroll_y => 1);	1471	my $spellsw = $SPELL_PAGE = new CFPlus::UI::ScrolledWindow (expand => 1, scroll_y => 1);
1382	$spellsw->add ($SPELL_PAGE = new CFPlus::UI::SpellList);	1472	$spellsw->add ($SPELL_LIST = new CFPlus::UI::SpellList);
1383	$ntb->add (	1473	$ntb->add (
1384	"Spellbook (F4)" => $spellsw,	1474	"Spellbook (F4)" => $spellsw,
1385	"Displays all spells you have and lets you edit keyboard shortcuts for them."	1475	"Displays all spells you have and lets you edit keyboard shortcuts for them."
1386	);	1476	);
1387	$ntb->add (	1477	$ntb->add (
1388	"Inventory (F5)" => $INVENTORY_PAGE = inventory_widget,	1478	"Inventory (F5)" => $INVENTORY_PAGE = inventory_widget,
1389	"Toggles the inventory window, where you can manage your loot (or treasures :). "	1479	"Toggles the inventory window, where you can manage your loot (or treasures :). "
1390	. "You can also hit the <b>Tab</b>-key to show/hide the Inventory."	1480	. "You can also hit the <b>Tab</b>-key to show/hide the Inventory."
1391	);	1481	);
		1482	$ntb->add (Pickup => autopickup_setup,
		1483	"Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them.");
1392		1484
1393	$ntb->set_current_page ($INVENTORY_PAGE);	1485	$ntb->set_current_page ($INVENTORY_PAGE);
1394		1486
1395	$plwin->add ($ntb);	1487	$plwin->add ($ntb);
1396	$plwin	1488	$plwin
1397	}	1489	}
1398		1490
1399	sub update_bindings {
1400	$BIND_UPD_CB->() if $BIND_UPD_CB;
1401	}
1402
1403	sub keyboard_setup {	1491	sub keyboard_setup {
1404	my $binding_list = new CFPlus::UI::VBox;	1492	CFPlus::Macro::keyboard_setup
1405
1406	my $refresh;
1407	$refresh = $BIND_UPD_CB = sub {
1408	$binding_list->clear ();
1409
1410	for my $mod (keys %{$::CFG->{profile}{default}{bindings}}) {
1411	for my $sym (keys %{$::CFG->{profile}{default}{bindings}{$mod}}) {
1412	my $cmds = $::CFG->{profile}{default}{bindings}{$mod}{$sym};
1413	next unless ref $cmds eq 'ARRAY' and @$cmds > 0;
1414
1415	my $lbl = join "; ", @$cmds;
1416	my $nam = CFPlus::BindingEditor::keycombo_to_name ($mod, $sym);
1417	$binding_list->add (my $hb = new CFPlus::UI::HBox);
1418	$hb->add (new CFPlus::UI::Button
1419	text => "delete",
1420	tooltip => "Deletes the binding",
1421	on_activate => sub {
1422	$binding_list->remove ($hb);
1423	delete $::CFG->{profile}{default}{bindings}{$mod}{$sym};
1424	0
1425	});
1426
1427	$hb->add (new CFPlus::UI::Button
1428	text => "edit",
1429	tooltip => "Edits the binding",
1430	on_activate => sub {
1431	$::BIND_EDITOR->set_binding (
1432	$mod, $sym, $::CFG->{profile}{default}{bindings}{$mod}{$sym},
1433	sub {
1434	my ($nmod, $nsym, $ncmds) = @_;
1435	$::BIND_EDITOR->cfg_unbind ($mod, $sym);
1436	$::BIND_EDITOR->cfg_bind ($nmod, $nsym, $ncmds);
1437	$refresh->();
1438	$SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1439	$SETUP_DIALOG->show;
1440	},
1441	sub {
1442	$SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1443	$SETUP_DIALOG->show;
1444	});
1445	$::BIND_EDITOR->show;
1446	$SETUP_DIALOG->hide;
1447	0
1448	});
1449
1450	$hb->add (new CFPlus::UI::Label text => "(Key: $nam)");
1451	$hb->add (new CFPlus::UI::Label text => $lbl, expand => 1);
1452	}
1453	}
1454	};
1455
1456	my $vb = new CFPlus::UI::VBox;
1457	$vb->add (my $hb = new CFPlus::UI::HBox);
1458	$hb->add (new CFPlus::UI::Label text => "only shift-up stops fire");
1459	$hb->add (new CFPlus::UI::CheckBox
1460	expand => 1,
1461	state => $CFG->{shift_fire_stop},
1462	tooltip => "If this checkbox is enabled you will stop fire only if you stop pressing shift",
1463	on_changed => sub {
1464	my ($cbox, $value) = @_;
1465	$CFG->{shift_fire_stop} = $value;
1466	0
1467	});
1468
1469	$vb->add ($binding_list);
1470	$vb->add (my $hb = new CFPlus::UI::HBox);
1471
1472	$hb->add (new CFPlus::UI::Button
1473	text => "record new",
1474	expand => 1,
1475	tooltip => "This button opens the binding editor with an empty binding.",
1476	on_activate => sub {
1477	$::BIND_EDITOR->set_binding (undef, undef, [],
1478	sub {
1479	my ($mod, $sym, $cmds) = @_;
1480	$::BIND_EDITOR->cfg_bind ($mod, $sym, $cmds);
1481	$refresh->();
1482	$SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1483	$SETUP_DIALOG->show;
1484	},
1485	sub {
1486	$SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD);
1487	$SETUP_DIALOG->show;
1488	},
1489	);
1490	$SETUP_DIALOG->hide;
1491	$::BIND_EDITOR->show;
1492	0
1493	},
1494	);
1495
1496	$hb->add (new CFPlus::UI::Button
1497	text => "close",
1498	tooltip => "Closes the binding window",
1499	expand => 1,
1500	on_activate => sub {
1501	$SETUP_DIALOG->hide;
1502	0
1503	}
1504	);
1505
1506	$refresh->();
1507
1508	$vb
1509	}	1493	}
1510		1494
1511	sub help_window {	1495	sub help_window {
1512	my $win = new CFPlus::UI::FancyFrame	1496	my $win = new CFPlus::UI::Toplevel
1513	x => 'center',	1497	x => 'center',
1514	y => 'center',	1498	y => 'center',
1515	z => 2,	1499	z => 4,
1516	name => 'doc_browser',	1500	name => 'doc_browser',
1517	force_w => int $WIDTH * 7/8,	1501	force_w => int $WIDTH * 7/8,
1518	force_h => int $HEIGHT * 7/8,	1502	force_h => int $HEIGHT * 7/8,
1519	title => "Help Browser",	1503	title => "Help Browser",
1520	has_close_button => 1;	1504	has_close_button => 1;
1521		1505
1522	$win->add (my $vbox = new CFPlus::UI::VBox);	1506	$win->add (my $vbox = new CFPlus::UI::VBox);
1523		1507
		1508	$vbox->add (new CFPlus::UI::FancyFrame
		1509	label => "Navigation",
1524	$vbox->add (my $buttons = new CFPlus::UI::HBox);	1510	child => (my $buttons = new CFPlus::UI::HBox),
		1511	);
1525	$vbox->add (my $viewer = new CFPlus::UI::TextScroller	1512	$vbox->add (my $viewer = new CFPlus::UI::TextScroller
1526	expand => 1, fontsize => 0.8, padding_x => 4);	1513	expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
1527		1514
1528	$buttons->add (new CFPlus::UI::Label text => "Choose a document to display: ");	1515	my @history;
1529	$buttons->add (my $combo = new CFPlus::UI::Selector	1516	my @future;
1530	value => undef,	1517	my $curnode;
1531	options => [	1518
1532	[intro => "Introduction"],	1519	my $load_node; $load_node = sub {
1533	[manual => "Main Manual"],	1520	my ($node, $para) = @_;
1534	[skill_help => "Skill Reference"],	1521
1535	[command_help => "Command Reference"],	1522	$buttons->clear;
1536	[dmcommand_help => "DM Commands"],	1523
1537	[COPYING => "License Terms"],	1524	$buttons->add (new CFPlus::UI::Button
1538	],	1525	text => "⇤",
		1526	tooltip => "back to the starting page",
1539	on_changed => sub {	1527	on_activate => sub {
1540	my ($self, $pod) = @_;	1528	unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
1541		1529	unshift @future, @history;
1542	$viewer->clear;	1530	@history = ();
1543	$viewer->add_paragraph (CFPlus::Pod::section pod => $pod);	1531	$load_node->(@{shift @future});
1544	$viewer->set_offset (0);
1545
1546	0	1532	},
		1533	);
		1534
		1535	if (@history) {
		1536	$buttons->add (new CFPlus::UI::Button
		1537	text => "⋘",
		1538	tooltip => "back to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $history[-1][0]) . "</i>",
		1539	on_activate => sub {
		1540	unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
		1541	$load_node->(@{pop @history});
		1542	},
		1543	);
1547	},	1544	}
1548	on_visibility_change => sub {	1545
1549	my ($self, $visible) = @_;	1546	if (@future) {
1550	return unless $visible;	1547	$buttons->add (new CFPlus::UI::Button
1551	return if $self->{value};	1548	text => "⋙",
1552	$self->set_value ("intro");	1549	tooltip => "forward to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $future[0][0]) . "</i>",
		1550	on_activate => sub {
		1551	push @history, [$curnode, $viewer->current_paragraph];
		1552	$load_node->(@{shift @future});
		1553	},
1553	0	1554	);
1554	},	1555	}
		1556
		1557	$buttons->add (new CFPlus::UI::Label text => " ");
		1558
		1559	my @path = CFPlus::Pod::full_path_of $node;
		1560	pop @path; # drop current node
		1561
		1562	for my $node (@path) {
		1563	$buttons->add (new CFPlus::UI::Button
		1564	text => $node->{kw}[0],
		1565	tooltip => "go to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $node) . "</i>",
		1566	on_activate => sub {
		1567	push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
		1568	$load_node->($node);
		1569	},
		1570	);
		1571	$buttons->add (new CFPlus::UI::Label text => "/");
		1572	}
		1573
		1574	$buttons->add (new CFPlus::UI::Label text => $node->{kw}[0], padding_x => 4, padding_y => 4);
		1575
		1576	$curnode = $node;
		1577
		1578	$viewer->clear;
		1579	$viewer->add_paragraph (CFPlus::Pod::as_paragraphs CFPlus::Pod::section_of $curnode);
		1580	$viewer->scroll_to ($para);
1555	);	1581	};
		1582
		1583	$load_node->(CFPlus::Pod::find pod => "mainpage");
		1584
		1585	$CFPlus::Pod::goto_document = sub {
		1586	my (@path) = @_;
		1587
		1588	push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
		1589
		1590	$load_node->((CFPlus::Pod::find @path)[0]);
		1591	$win->show;
		1592	};
1556		1593
1557	$win	1594	$win
		1595	}
		1596
		1597	sub open_string_query {
		1598	my ($title, $cb, $txt, $tooltip) = @_;
		1599	my $dialog = new CFPlus::UI::Toplevel
		1600	x => "center",
		1601	y => "center",
		1602	z => 50,
		1603	force_w => $WIDTH * 4/5,
		1604	title => $title;
		1605
		1606	$dialog->add (
		1607	my $e = new CFPlus::UI::Entry
		1608	on_activate => sub { $cb->(@_); $dialog->hide; 0 },
		1609	on_key_down => sub { $_[1]->{sym} == 27 and $dialog->hide; 0 },
		1610	tooltip => $tooltip
		1611	);
		1612
		1613	$e->grab_focus;
		1614	$e->set_text ($txt) if $txt;
		1615	$dialog->show;
		1616	}
		1617
		1618	sub open_quit_dialog {
		1619	unless ($QUIT_DIALOG) {
		1620	$QUIT_DIALOG = new CFPlus::UI::Toplevel
		1621	x => "center",
		1622	y => "center",
		1623	z => 50,
		1624	title => "Really Quit?",
		1625	on_key_down => sub {
		1626	my ($dialog, $ev) = @_;
		1627	$ev->{sym} == 27 and $dialog->hide;
		1628	}
		1629	;
		1630
		1631	$QUIT_DIALOG->add (my $vb = new CFPlus::UI::VBox expand => 1);
		1632
		1633	$vb->add (new CFPlus::UI::Label
		1634	text => "You should find a savebed and apply it first!",
		1635	max_w => $WIDTH * 0.25,
		1636	ellipsize => 0,
		1637	);
		1638	$vb->add (my $hb = new CFPlus::UI::HBox expand => 1);
		1639	$hb->add (new CFPlus::UI::Button
		1640	text => "Ok",
		1641	expand => 1,
		1642	on_activate => sub { $QUIT_DIALOG->hide; 0 },
		1643	);
		1644	$hb->add (new CFPlus::UI::Button
		1645	text => "Quit anyway",
		1646	expand => 1,
		1647	on_activate => sub { exit },
		1648	);
		1649	}
		1650
		1651	$QUIT_DIALOG->show;
		1652	$QUIT_DIALOG->grab_focus;
		1653	}
		1654
		1655	sub show_tip_of_the_day {
		1656	# find all tips
		1657	my @tod = CFPlus::Pod::find tip_of_the_day => "*";
		1658
		1659	CFPlus::DB::get state => "tip_of_the_day", sub {
		1660	my ($todindex) = @_;
		1661	$todindex = 0 if $todindex >= @tod;
		1662	CFPlus::DB::put state => tip_of_the_day => $todindex + 1, sub { };
		1663
		1664	# create dialog
		1665	my $dialog;
		1666
		1667	my $close = sub {
		1668	$dialog->destroy;
		1669	};
		1670
		1671	$dialog = new CFPlus::UI::Toplevel
		1672	x => "center",
		1673	y => "center",
		1674	z => 3,
		1675	name => 'tip_of_the_day',
		1676	force_w => int $WIDTH * 4/9,
		1677	force_h => int $WIDTH * 2/9,
		1678	title => "Tip of the day #" . (1 + $todindex),
		1679	child => my $vbox = new CFPlus::UI::VBox,
		1680	has_close_button => 1,
		1681	on_delete => $close,
		1682	;
		1683
		1684	$vbox->add (my $viewer = new CFPlus::UI::TextScroller
		1685	expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
		1686	$viewer->add_paragraph (CFPlus::Pod::as_paragraphs CFPlus::Pod::section_of $tod[$todindex]);
		1687
		1688	$vbox->add (my $table = new CFPlus::UI::Table col_expand => [0, 1]);
		1689
		1690	$table->add (0, 0, new CFPlus::UI::Button
		1691	text => "Close",
		1692	tooltip => "Close the tip of the day window. To never see it again, disable the tip of the day in the <b>Server Setup</b>.",
		1693	on_activate => $close,
		1694	);
		1695
		1696	$table->add (2, 0, new CFPlus::UI::Button
		1697	text => "Next",
		1698	tooltip => "Show the next <b>Tip of the day</b>.",
		1699	on_activate => sub {
		1700	$close->();
		1701	&show_tip_of_the_day;
		1702	},
		1703	);
		1704
		1705	$dialog->show;
		1706	};
1558	}	1707	}
1559		1708
1560	sub sdl_init {	1709	sub sdl_init {
1561	CFPlus::SDL_Init	1710	CFPlus::SDL_Init
1562	and die "SDL::Init failed!\n";	1711	and die "SDL::Init failed!\n";
…		…
1597	z => 100,	1746	z => 100,
1598	force_x => "max",	1747	force_x => "max",
1599	force_y => 0;	1748	force_y => 0;
1600	$DEBUG_STATUS->show;	1749	$DEBUG_STATUS->show;
1601		1750
1602	$BIND_EDITOR = new CFPlus::BindingEditor (x => "max", y => 0);
1603
1604	$STATUSBOX = new CFPlus::UI::Statusbox;	1751	$STATUSBOX = new CFPlus::UI::Statusbox;
1605	$STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);	1752	$STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);
1606		1753
1607	(new CFPlus::UI::Frame	1754	(new CFPlus::UI::Frame
1608	bg => [0, 0, 0, 0.4],	1755	bg => [0, 0, 0, 0.4],
1609	force_x => 0,	1756	force_x => 0,
1610	force_y => "max",	1757	force_y => "max",
1611	child => $STATUSBOX,	1758	child => $STATUSBOX,
1612	)->show;	1759	)->show;
1613		1760
1614	CFPlus::UI::FancyFrame->new (	1761	CFPlus::UI::Toplevel->new (
1615	title => "Map",	1762	title => "Map",
1616	name => "mapmap",	1763	name => "mapmap",
1617	x => 0,	1764	x => 0,
1618	y => $FONTSIZE + 8,	1765	y => $FONTSIZE + 8,
1619	border_bg => [1, 1, 1, 192/255],	1766	border_bg => [1, 1, 1, 192/255],
…		…
1644	font => $FONT_FIXED,	1791	font => $FONT_FIXED,
1645	fontsize => $::CFG->{log_fontsize},	1792	fontsize => $::CFG->{log_fontsize},
1646	indent => -4,	1793	indent => -4,
1647	can_hover => 1,	1794	can_hover => 1,
1648	can_events => 1,	1795	can_events => 1,
		1796	max_par => $CFG->{logview_max_par},
1649	tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",	1797	tooltip => "<b>Server Log</b>. This text viewer contains all recent messages sent by the server.",
1650	;	1798	;
1651		1799
1652	$SETUP_DIALOG = new CFPlus::UI::FancyFrame	1800	$SETUP_DIALOG = new CFPlus::UI::Toplevel
1653	title => "Setup",	1801	title => "Setup",
1654	name => "setup_dialog",	1802	name => "setup_dialog",
1655	x => 'center',	1803	x => 'center',
1656	y => 'center',	1804	y => 'center',
1657	z => 2,	1805	z => 2,
…		…
1665	$SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFPlus::UI::Notebook expand => 1, debug => 1,	1813	$SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFPlus::UI::Notebook expand => 1, debug => 1,
1666	filter => new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);	1814	filter => new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);
1667		1815
1668	$SETUP_NOTEBOOK->add (Server => $SETUP_SERVER = server_setup,	1816	$SETUP_NOTEBOOK->add (Server => $SETUP_SERVER = server_setup,
1669	"Configure the server to play on, your username, password and other server-related options.");	1817	"Configure the server to play on, your username, password and other server-related options.");
1670	$SETUP_NOTEBOOK->add (Pickup => autopickup_setup,	1818	$SETUP_NOTEBOOK->add (Client => client_setup,
1671	"Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them.");	1819	"Configure various client-specific settings.");
1672	$SETUP_NOTEBOOK->add (Graphics => graphics_setup,	1820	$SETUP_NOTEBOOK->add (Graphics => graphics_setup,
1673	"Configure the video mode, performance, fonts and other graphical aspects of the game.");	1821	"Configure the video mode, performance, fonts and other graphical aspects of the game.");
1674	$SETUP_NOTEBOOK->add (Audio => audio_setup,	1822	$SETUP_NOTEBOOK->add (Audio => audio_setup,
1675	"Configure the use of audio, sound effects and background music.");	1823	"Configure the use of audio, sound effects and background music.");
1676	$SETUP_NOTEBOOK->add (Keyboard => $SETUP_KEYBOARD = keyboard_setup,	1824	$SETUP_NOTEBOOK->add (Keyboard => $SETUP_KEYBOARD = keyboard_setup,
…		…
1708	);	1856	);
1709		1857
1710	$BUTTONBAR->add (new CFPlus::UI::Flopper text => "Help!", other => $HELP_WINDOW = help_window,	1858	$BUTTONBAR->add (new CFPlus::UI::Flopper text => "Help!", other => $HELP_WINDOW = help_window,
1711	tooltip => "View Documentation");	1859	tooltip => "View Documentation");
1712		1860
		1861
1713	$BUTTONBAR->add (new CFPlus::UI::Button	1862	$BUTTONBAR->add (new CFPlus::UI::Button
1714	text => "Quit",	1863	text => "Quit",
1715	tooltip => "Terminates the program",	1864	tooltip => "Terminates the program",
1716	on_activate => sub {	1865	on_activate => sub {
1717	if ($CONN) {	1866	if ($CONN) {
…		…
1728	}	1877	}
1729		1878
1730	$STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);	1879	$STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
1731	}	1880	}
1732		1881
		1882	sub setup_build_button {
		1883	my ($enabled) = @_;
		1884	if ($enabled) {
		1885	$BUILD_BUTTON->hide if $BUILD_BUTTON;
		1886	$BUILD_BUTTON ||= new CFPlus::UI::Button
		1887	text => "Build",
		1888	tooltip => "Opens the ingame builder",
		1889	on_activate => sub {
		1890	if ($CONN) {
		1891	$CONN->send_ext_req (builder_player_items => sub {
		1892	open_ingame_editor ($_[0]) if exists $_[0]->{items};
		1893	});
		1894	}
		1895	0
		1896	};
		1897	$BUTTONBAR->add ($BUILD_BUTTON);
		1898	} else {
		1899	$BUILD_BUTTON->hide if $BUILD_BUTTON;
		1900	}
		1901	}
		1902
		1903	sub open_ingame_editor {
		1904	my ($msg) = @_;
		1905
		1906	my $win = new CFPlus::UI::Toplevel
		1907	x => 0,
		1908	y => 'center',
		1909	z => 4,
		1910	name => 'builder_window',
		1911	force_w => int $WIDTH * 1/4,
		1912	force_h => int $HEIGHT * 3/4,
		1913	title => "In game builder",
		1914	has_close_button => 1;
		1915
		1916	my $r = new CFPlus::UI::ScrolledWindow (
		1917	expand => 1,
		1918	scroll_y => 1
		1919	);
		1920	$r->add (my $vb = new CFPlus::UI::VBox);
		1921	$win->add ($r);
		1922
		1923
		1924	$vb->add (
		1925	new CFPlus::UI::Button
		1926	text => "Disable build mode",
		1927	on_activate => sub { $::IN_BUILD_MODE = undef }
		1928	);
		1929	$vb->add (
		1930	new CFPlus::UI::Button
		1931	text => "ERASE",
		1932	on_activate => sub { $::IN_BUILD_MODE = { do_erase => 1 } }
		1933	);
		1934
		1935	for my $itemarchname (
		1936	sort {
		1937	$msg->{items}->{$a}->{build_arch_name}
		1938	cmp $msg->{items}->{$b}->{build_arch_name}
		1939	} keys %{$msg->{items}}
		1940	) {
		1941	my $info = $msg->{items}->{$itemarchname};
		1942	$vb->add (
		1943	new CFPlus::UI::Button text => $info->{build_arch_name},
		1944	on_activate => sub {
		1945	$::IN_BUILD_MODE = { item => $itemarchname, info => $info };
		1946
		1947	if (grep { $msg->{items}->{$itemarchname}->{$_} } qw/has_connection has_name has_text/) {
		1948	build_mode_query_arch_info ();
		1949	}
		1950	}
		1951	);
		1952	}
		1953
		1954	$win->show;
		1955	}
		1956
		1957	sub build_mode_query_arch_info {
		1958	my ($iteminfo) = $::IN_BUILD_MODE;
		1959	my $itemarchname = $iteminfo->{item};
		1960	my $info = $iteminfo->{info};
		1961
		1962	my $dialog = new CFPlus::UI::Toplevel
		1963	x => "center",
		1964	y => "center",
		1965	z => 50,
		1966	force_w => int $WIDTH * 1/2,
		1967	title => "Enter information for placement of '$itemarchname'",
		1968	has_close_button => 1;
		1969
		1970	$dialog->add (my $vb = new CFPlus::UI::VBox expand => 1);
		1971
		1972	$vb->add (my $table = new CFPlus::UI::Table expand => 1);
		1973	my $row = 0;
		1974	if ($info->{has_name}) {
		1975	$table->add (0, $row, new CFPlus::UI::Label text => "Name:");
		1976	$table->add (1, $row++, new CFPlus::UI::Entry expand => 1, on_changed => sub { $::IN_BUILD_MODE->{name} = $_[1]; 0 });
		1977	}
		1978	if ($info->{has_text}) {
		1979	$table->add (0, $row, new CFPlus::UI::Label text => "Text:");
		1980	$table->add (1, $row++, new CFPlus::UI::Entry expand => 1, on_changed => sub { $::IN_BUILD_MODE->{text} = $_[1]; 0 });
		1981	}
		1982	if ($info->{has_connection}) {
		1983	$table->add (0, $row, new CFPlus::UI::Label text => "Connection ID:");
		1984	$table->add (1, $row++,
		1985	new CFPlus::UI::Entry
		1986	expand => 1,
		1987	on_changed => sub { $::IN_BUILD_MODE->{connection} = $_[1]; 0 },
		1988	tooltip => "Enter the connection ID here. The connection ID connects actors like a lever to a gate or a magic ear to a gate"
		1989	);
		1990	}
		1991
		1992	$vb->add (my $hb = new CFPlus::UI::HBox expand => 1);
		1993	$hb->add (new CFPlus::UI::Button
		1994	text => "Close",
		1995	expand => 1,
		1996	on_activate => sub { $dialog->hide; 0 },
		1997	);
		1998	$dialog->show;
		1999	}
		2000
1733	sub video_shutdown {	2001	sub video_shutdown {
1734	CFPlus::OpenGL::shutdown;	2002	CFPlus::OpenGL::shutdown;
1735		2003
1736	undef $SDL_ACTIVE;	2004	undef $SDL_ACTIVE;
1737	}	2005	}
…		…
1768	CFPlus::Mix_AllocateChannels 8;	2036	CFPlus::Mix_AllocateChannels 8;
1769	CFPlus::MixMusic::volume $CFG->{bgm_volume} * 128;	2037	CFPlus::MixMusic::volume $CFG->{bgm_volume} * 128;
1770		2038
1771	audio_music_finished;	2039	audio_music_finished;
1772		2040
		2041	local $_;
1773	while (<$fh>) {	2042	while (<$fh>) {
1774	next if /^\s*#/;	2043	next if /^\s*#/;
1775	next if /^\s*$/;	2044	next if /^\s*$/;
1776		2045
1777	my ($file, $volume, $event) = split /\s+/, $_, 3;	2046	my ($file, $volume, $event) = split /\s+/, $_, 3;
…		…
1854	if $CONN;	2123	if $CONN;
1855	});	2124	});
1856		2125
1857	%SDL_CB = (	2126	%SDL_CB = (
1858	CFPlus::SDL_QUIT => sub {	2127	CFPlus::SDL_QUIT => sub {
1859	Event::unloop -1;	2128	exit;
1860	},	2129	},
1861	CFPlus::SDL_VIDEORESIZE => sub {	2130	CFPlus::SDL_VIDEORESIZE => sub {
1862	},	2131	},
1863	CFPlus::SDL_VIDEOEXPOSE => sub {	2132	CFPlus::SDL_VIDEOEXPOSE => sub {
1864	CFPlus::UI::full_refresh;	2133	CFPlus::UI::full_refresh;
1865	},	2134	},
1866	CFPlus::SDL_ACTIVEEVENT => sub {	2135	CFPlus::SDL_ACTIVEEVENT => sub {
1867	# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#	2136	# not useful, as APPACTIVE include sonly iconified state, not unmapped
		2137	# printf "active %x %x\n", $_[0]{gain}, $_[0]{state};#d#
		2138	# printf "A\n" if $_[0]{state} & CFPlus::SDL_APPACTIVE;
		2139	# printf "K\n" if $_[0]{state} & CFPlus::SDL_APPINPUTFOCUS;
		2140	# printf "M\n" if $_[0]{state} & CFPlus::SDL_APPMOUSEFOCUS;
1868	},	2141	},
1869	CFPlus::SDL_KEYDOWN => sub {	2142	CFPlus::SDL_KEYDOWN => sub {
1870	if ($_[0]{mod} & CFPlus::KMOD_ALT && $_[0]{sym} == 13) {	2143	if ($_[0]{mod} & CFPlus::KMOD_ALT && $_[0]{sym} == 13) {
1871	# alt-enter	2144	# alt-enter
1872	$FULLSCREEN_ENABLE->toggle;	2145	$FULLSCREEN_ENABLE->toggle;
…		…
1893		2166
1894	$SIG{INT} = $SIG{TERM} = sub { exit };	2167	$SIG{INT} = $SIG{TERM} = sub { exit };
1895		2168
1896	{	2169	{
1897	CFPlus::read_cfg "$Crossfire::VARDIR/cfplusrc";	2170	CFPlus::read_cfg "$Crossfire::VARDIR/cfplusrc";
		2171	CFPlus::DB::Server::run;
		2172
1898	CFPlus::UI::set_layout ($::CFG->{layout});	2173	CFPlus::UI::set_layout ($::CFG->{layout});
1899		2174
1900	my %DEF_CFG = (	2175	my %DEF_CFG = (
1901	sdl_mode => 0,	2176	sdl_mode => 0,
1902	width => 640,	2177	width => 640,
1903	height => 480,	2178	height => 480,
1904	fullscreen => 0,	2179	fullscreen => 0,
1905	fast => 0,	2180	fast => 0,
1906	map_scale => 1,	2181	map_scale => 1,
1907	fow_enable => 1,	2182	fow_enable => 1,
1908	fow_intensity => 0.45,	2183	fow_intensity => 0.45,
1909	fow_smooth => 0,	2184	fow_smooth => 0,
		2185	map_smoothing => 1,
1910	gui_fontsize => 1,	2186	gui_fontsize => 1,
1911	log_fontsize => 0.7,	2187	log_fontsize => 0.7,
1912	gauge_fontsize => 1,	2188	gauge_fontsize => 1,
1913	gauge_size => 0.35,	2189	gauge_size => 0.35,
1914	stat_fontsize => 0.7,	2190	stat_fontsize => 0.7,
1915	mapsize => 100,	2191	mapsize => 100,
1916	say_command => 'say',	2192	say_command => 'chat',
1917	audio_enable => 1,	2193	audio_enable => 1,
1918	bgm_enable => 1,	2194	bgm_enable => 1,
1919	bgm_volume => 0.25,	2195	bgm_volume => 0.25,
1920	face_prefetch => 0,	2196	face_prefetch => 0,
1921	output_sync => 1,	2197	output_sync => 1,
1922	output_count => 1,	2198	output_count => 1,
		2199	output_rate => "",
1923	pickup => 0,	2200	pickup => 0,
1924	inv_sort => "mtime",	2201	inv_sort => "mtime",
1925	default => "profile", # default profile	2202	default => "profile", # default profile
		2203	show_tips => 1,
		2204	logview_max_par => 1000,
1926	);	2205	);
1927		2206
1928	while (my ($k, $v) = each %DEF_CFG) {	2207	while (my ($k, $v) = each %DEF_CFG) {
1929	$CFG->{$k} = $v unless exists $CFG->{$k};	2208	$CFG->{$k} = $v unless exists $CFG->{$k};
1930	}	2209	}
1931		2210
1932	$CFG->{profile}{default}{host} ||= "crossfire.schmorp.de";	2211	$CFG->{profile}{default}{host} ||= "crossfire.schmorp.de";
		2212	$PROFILE = $CFG->{profile}{default};
		2213
		2214	# convert old bindings (only default profile matters)
		2215	if (my $bindings = delete $PROFILE->{bindings}) {
		2216	while (my ($mod, $syms) = each %$bindings) {
		2217	while (my ($sym, $cmds) = each %$syms) {
		2218	push @{ $PROFILE->{macro} }, {
		2219	accelkey => [$mod*1, $sym*1],
		2220	action => $cmds,
		2221	};
		2222	}
		2223	}
		2224	}
1933		2225
1934	sdl_init;	2226	sdl_init;
1935		2227
1936	@SDL_MODES = reverse	2228	@SDL_MODES = reverse
1937	grep $_->[0] >= 640 && $_->[1] >= 480,	2229	grep $_->[0] >= 640 && $_->[1] >= 480,
…		…
1974	# }	2266	# }
1975	# my $t2 = Time::HiRes::time;	2267	# my $t2 = Time::HiRes::time;
1976	# warn $t2-$t1;	2268	# warn $t2-$t1;
1977	# }	2269	# }
1978		2270
		2271	$startup_done->();
		2272
1979	video_init;	2273	video_init;
1980	audio_init;	2274	audio_init;
1981	}	2275	}
		2276
		2277	show_tip_of_the_day if $CFG->{show_tips};
1982		2278
1983	Event::loop;	2279	Event::loop;
1984	#CFPlus::SDL_Quit;	2280	#CFPlus::SDL_Quit;
1985	#CFPlus::_exit 0;	2281	#CFPlus::_exit 0;
1986		2282
		2283	END {
1987	END { CFPlus::SDL_Quit }	2284	CFPlus::SDL_Quit;
		2285	CFPlus::DB::Server::stop;
		2286	}
1988		2287
1989	=head1 NAME	2288	=head1 NAME
1990		2289
1991	cfplus - A Crossfire+ and Crossfire game client	2290	cfplus - A Crossfire+ and Crossfire game client
1992		2291

Diff Legend

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