ViewVC Help

View File | Revision Log | Show Annotations | Download File

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

Comparing deliantra/Deliantra-Client/bin/deliantra (file contents):
Revision 1.17 by root, Wed Dec 26 20:46:39 2007 UTC vs.
Revision 1.72 by root, Tue Sep 2 17:15:39 2008 UTC

…		…
49	}	49	}
50	}	50	}
51		51
52	if ($^O eq "MSWin32") {	52	if ($^O eq "MSWin32") {
53	# pango is relocatable on win32	53	# pango is relocatable on win32
54	} else {	54	} elsif (-e "$root/pangoversion") {
55	open my $fh, "<:perlio", "$root/pangoversion"	55	open my $fh, "<:perlio", "$root/pangoversion"
56	or die "pangoversion: $!";	56	or die "pangoversion: $!";
57	my $PANGO = <$fh>;	57	my $PANGO = <$fh>;
58	# unix, need to patch pango rc file	58	# unix, need to patch pango rc file
59	open my $fh, "<:perlio", "$root/usr/lib/pango/$PANGO/module-files.d/libpango1.0-0.modules"	59	open my $fh, "<:perlio", "$root/usr/lib/pango/$PANGO/module-files.d/libpango1.0-0.modules"
…		…
69		69
70	$ENV{PANGO_RC_FILE} = "$root/pango.rc";	70	$ENV{PANGO_RC_FILE} = "$root/pango.rc";
71	open my $fh, ">:perlio", $ENV{PANGO_RC_FILE}	71	open my $fh, ">:perlio", $ENV{PANGO_RC_FILE}
72	or die "$ENV{PANGO_RC_FILE}: $!";	72	or die "$ENV{PANGO_RC_FILE}: $!";
73	print $fh "[Pango]\nModuleFiles = $root/pango-modules\n";	73	print $fh "[Pango]\nModuleFiles = $root/pango-modules\n";
		74	} else {
		75	# OS X
		76	$ENV{FC_CONFIG_FILE} = "$root/fonts.conf"; # no effect??!?!
		77	$ENV{FC_CONFIG_DIR} = $root; # no effect??!?!
		78	$ENV{PANGO_RC_FILE} = "$root/pango.rc";
		79	$ENV{DYLD_LIBRARY_PATH} = $root;
		80	chdir $root; # for pango modules, maybe other things
74	}	81	}
75		82
76	unshift @INC, $root;	83	unshift @INC, $root;
77	}	84	}
78	}	85	}
79		86
80	# prepend private library directory	87	# prepend private library directory
81	BEGIN {	88	BEGIN {
82	for (grep !ref, @INC) {	89	for (grep !ref, @INC) {
83	my $path = "$_/Deliantra/Client/private/dc";	90	my $path = "$_/Deliantra/Client/private";
84	if (-d $path) {	91	if (-d $path) {
85	unshift @INC, $path;	92	unshift @INC, $path;
86	last;	93	last;
87	}	94	}
88	}	95	}
…		…
90		97
91	# need to do it again because that pile of garbage called PAR nukes it before main	98	# need to do it again because that pile of garbage called PAR nukes it before main
92	unshift @INC, $ENV{PAR_TEMP}	99	unshift @INC, $ENV{PAR_TEMP}
93	if %PAR::LibCache;	100	if %PAR::LibCache;
94		101
95	use Time::HiRes 'time';
96	use EV;	102	use EV;
		103	BEGIN { *time = \&EV::time }
		104
97	use List::Util qw(max min);	105	use List::Util qw(max min);
98		106
99	use Deliantra;	107	use Deliantra;
100	use Deliantra::Protocol::Constants;	108	use Deliantra::Protocol::Constants;
101		109
		110	use AnyEvent::Util ();
		111	use AnyEvent::DNS;
		112	use AnyEvent::Socket ();
		113
102	use Compress::LZF;	114	use Compress::LZF;
		115	use JSON::XS;
103		116
104	use dc;	117	use DC;
		118
		119	sub crash($;$) {
		120	# nop during compiletime
		121	}
		122
		123	BEGIN {
		124	$SIG{__DIE__} = sub {
		125	return if $^S;
		126	crash "CRASH/DIE: $_[0]" => 1;
		127	DC::fatal Carp::longmess "$_[0]";
		128	}
		129	}
		130
105	use dc::OpenGL ();	131	use DC::OpenGL ();
106	use dc::Protocol;	132	use DC::Protocol;
107	use dc::DB;	133	use DC::DB;
108	use dc::UI;	134	use DC::UI;
109	use dc::UI::Canvas;	135	use DC::UI::Canvas;
110	use dc::UI::Inventory;	136	use DC::UI::Inventory;
111	use dc::UI::SpellList;	137	use DC::UI::SpellList;
112	use dc::UI::Dockable;	138	use DC::UI::Dockable;
113	use dc::UI::MessageWindow;	139	use DC::UI::Dockbar;
114	use dc::UI::ChatView;	140	use DC::UI::ChatView;
		141	use DC::MessageDistributor;
115	use dc::Pod;	142	use DC::Pod;
116	use dc::MapWidget;	143	use DC::MapWidget;
117	use dc::Macro;	144	use DC::Macro;
118		145
119	$SIG{QUIT} = sub { Carp::cluck "QUIT" };	146	$SIG{QUIT} = sub { Carp::cluck "QUIT" };
120	$SIG{PIPE} = 'IGNORE';	147	$SIG{PIPE} = 'IGNORE';
121		148
122	$EV::DIED = sub {	149	$EV::DIED = sub {
		150	crash "CRASH/EV::DIED: $@" => 1;
123	dc::fatal Carp::longmess $@;	151	DC::fatal Carp::longmess $@;
124	};	152	};
125		153
126	my $MAX_FPS = 60;	154	my $MAX_FPS = 60;
127	my $MIN_FPS = 5; # unused as of yet
128		155
129	our $META_SERVER = "http://metaserver.schmorp.de/current.json";	156	our $META_SERVER = "http://metaserver.schmorp.de/current.json";
130		157
131	our $LAST_REFRESH;	158	our $LAST_REFRESH;
132	our $NOW;	159	our $NOW;
133		160
134	our $CFG;	161	our $CFG;
135	our $CONN;
136	our $PROFILE; # current profile	162	our $PROFILE; # current profile
137	our $FAST; # fast, low-quality mode, possibly useful for software-rendering	163	our $FAST; # fast, low-quality mode, possibly useful for software-rendering
138		164
139	our $WANT_REFRESH;	165	our $WANT_REFRESH;
140		166
		167	our $MODE_SLIDER;
		168	our $CAVEAT_LABEL;
		169
141	our @SDL_MODES;	170	our @SDL_MODES;
		171	our $SDL_REINIT = 1;
142	our $WIDTH;	172	our $WIDTH;
143	our $HEIGHT;	173	our $HEIGHT;
144	our $FULLSCREEN;	174	our $FULLSCREEN;
145	our $FONTSIZE;	175	our $FONTSIZE;
146		176
147	our $FONT_PROP;	177	our $FONT_PROP;
148	our $FONT_FIXED;	178	our $FONT_FIXED;
		179
		180	our $CONN;
149		181
150	our $MAP;	182	our $MAP;
151	our $MAPMAP;	183	our $MAPMAP;
152	our $MAPWIDGET;	184	our $MAPWIDGET;
153	our $COMPLETER;	185	our $COMPLETER;
…		…
179	our $SPELL_PAGE;	211	our $SPELL_PAGE;
180	our $SPELL_LIST;	212	our $SPELL_LIST;
181		213
182	our $HELP_WINDOW;	214	our $HELP_WINDOW;
183	our $MESSAGE_WINDOW;	215	our $MESSAGE_WINDOW;
		216	our $MESSAGE_DIST;
184	our $FLOORBOX;	217	our $FLOORBOX;
185	our $GAUGES;	218	our $GAUGES;
186	our $STATWIDS;	219	our $STATWIDS;
187		220
188	our $SDL_ACTIVE;	221	our $SDL_ACTIVE;
189	our %SDL_CB;	222	our %SDL_CB;
190		223
191	our $ALT_ENTER_MESSAGE;	224	our $ALT_ENTER_MESSAGE;
192	our $STATUSBOX;	225	our $STATUSBOX;
		226	our $MODBOX;
193	our $DEBUG_STATUS;	227	our $DEBUG_STATUS;
194		228
195	our $INV;	229	our $INV;
196	our $INVR;	230	our $INVR;
197	our $INVR_HB;	231	our $INVR_HB;
198		232
199	#############################################################################	233	#############################################################################
200		234
		235	# write a crash message blockingly to the socket, if possible
		236	# this is a bit too complicated for my tastes, but it was easy.
		237	*crash = sub($;$) {
		238	my ($msg, $backtrace) = @_;
		239
		240	return unless $CONN;
		241
		242	my $fh = $CONN->{fh}
		243	or return;
		244
		245	my $buf = delete $CONN->{wbuf};
		246
		247	$buf .= pack "n/a*", "exti " . JSON::XS::encode_json [clientlog => undef, substr $msg, 0, 8000];
		248
		249	AnyEvent::Util::fh_nonblocking $fh, 0;
		250	syswrite $fh, $buf;
		251	AnyEvent::Util::fh_nonblocking $fh, 1;
		252
		253	$msg =~ s/\s+$//;
		254
		255	# backtrace as second step, in case it crashes, too
		256	crash Carp::longmess "$msg\nbacktrace, for client version $DC::VERSION, generated"
		257	if $backtrace;
		258	};
		259
		260	#############################################################################
		261
201	sub status {	262	sub status {
202	$STATUSBOX->add (dc::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);	263	$STATUSBOX->add (DC::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
203	}	264	}
204		265
205	sub debug {	266	sub debug {
206	$DEBUG_STATUS->set_text ($_[0]);	267	$DEBUG_STATUS->set_text ($_[0]);
207	}	268	}
208		269
209	sub message {	270	sub message {
210	$MESSAGE_WINDOW->message (@_);	271	$MESSAGE_DIST->message (@_);
		272	}
		273
		274	sub update_modbox {
		275	my $mod = DC::SDL_GetModState;
		276
		277	my $markup;
		278
		279	$markup .= $mod & DC::KMOD_CTRL
		280	? ($MAPWIDGET->{ctrl} ? "[REPEAT]" : "[<span foreground='#888'>REPEAT</span>]")
		281	: "[<span foreground='#888'> once </span>]";
		282
		283	$markup .= $mod & DC::KMOD_SHIFT
		284	? ($MAPWIDGET->{shft} ? "[FIRE]" : "[<span foreground='#888'>FIRE</span>]")
		285	: "[<span foreground='#888'>move</span>]";
		286
		287	$markup .= $mod & (DC::KMOD_ALT | DC::KMOD_META)
		288	? "[ALT]"
		289	: "[<span foreground='#888'>alt</span>]";
		290
		291	$markup .= $mod & DC::KMOD_NUM
		292	? "[NUM]"
		293	: "[<span foreground='#888'>num</span>]";
		294
		295	# <tt> around next statement works around some bug that keeps the
		296	# "font =>" from being used on windows
		297	$MODBOX->set_markup ("<tt>$markup</tt>");
211	}	298	}
212		299
213	#############################################################################	300	#############################################################################
214	#TODO: maybe move into own audio module...	301	#TODO: maybe move into own audio module...
215		302
…		…
245		332
246	if (my $chunk = $AUDIO_CHUNK{$face}) {	333	if (my $chunk = $AUDIO_CHUNK{$face}) {
247	for (grep $_->[0] >= EV::now, @{(delete $AUDIO_PLAY{$face}) || []}) {	334	for (grep $_->[0] >= EV::now, @{(delete $AUDIO_PLAY{$face}) || []}) {
248	my (undef, $dx, $dy, $vol) = @$_;	335	my (undef, $dx, $dy, $vol) = @$_;
249		336
250	my $channel = dc::Channel::find;	337	my $channel = DC::Channel::find;
251	$channel->volume ($vol * $CFG->{effects_volume} * 128 / 255);	338	$channel->volume ($vol * $CFG->{effects_volume} * 128 / 255);
252	$channel->set_position_r ($dx, $dy, 20);	339	$channel->set_position_r ($dx, $dy, 20);
253	$chunk->play ($channel);	340	$chunk->play ($channel);
254	}	341	}
255	} else {	342	} else {
…		…
266	push @MUSIC_JINGLE, $meta; # push it oto the music/jingle queue	353	push @MUSIC_JINGLE, $meta; # push it oto the music/jingle queue
267	&audio_music_push ($face);	354	&audio_music_push ($face);
268	}	355	}
269	} else {	356	} else {
270	# fetch from database	357	# fetch from database
271	dc::DB::get res_data => $meta->{name}, sub {	358	DC::DB::get res_data => $meta->{name}, sub {
272	my $rwops = new dc::RW $_[0];	359	my $rwops = new DC::RW $_[0];
273	my $chunk = new dc::MixChunk $rwops	360	my $chunk = new DC::MixChunk $rwops
274	or Carp::confess "sound face " . (JSON::XS::encode_json $meta) . " unloadable: " . dc::Mix_GetError;	361	or Carp::confess "sound face " . (JSON::XS::encode_json $meta) . " unloadable: " . DC::Mix_GetError;
275	$chunk->volume (($meta->{data}{volume} || 1) * 128);	362	$chunk->volume (($meta->{data}{volume} || 1) * 128);
276	$AUDIO_CHUNK{$face} = $chunk;	363	$AUDIO_CHUNK{$face} = $chunk;
277		364
278	audio_sound_push ($face);	365	audio_sound_push ($face);
279	};	366	};
…		…
298	sub audio_music_set_meta {	385	sub audio_music_set_meta {
299	my ($meta) = @_;	386	my ($meta) = @_;
300		387
301	$MUSIC_PLAYING_META = $meta;	388	$MUSIC_PLAYING_META = $meta;
302	$MUSIC_PLAYING_WIDGET->set_markup (	389	$MUSIC_PLAYING_WIDGET->set_markup (
303	"<b>Name</b>: " . (dc::asxml $meta->{data}{name}) . "\n"	390	"<b>Name</b>: " . (DC::asxml $meta->{data}{name}) . "\n"
304	. "<b>Author</b>: " . (dc::asxml $meta->{data}{author}) . "\n"	391	. "<b>Author</b>: " . (DC::asxml $meta->{data}{author}) . "\n"
305	. "<b>Source</b>: " . (dc::asxml $meta->{data}{source}) . "\n"	392	. "<b>Source</b>: " . (DC::asxml $meta->{data}{source}) . "\n"
306	. "<b>License</b>: " . (dc::asxml $meta->{data}{license})	393	. "<b>License</b>: " . (DC::asxml $meta->{data}{license})
307	);	394	);
308	}	395	}
309		396
310	sub audio_music_update_volume {	397	sub audio_music_update_volume {
311	return unless $MUSIC_PLAYING_META;	398	return unless $MUSIC_PLAYING_META;
312	my $volume = $MUSIC_PLAYING_META->{data}{volume} || 1;	399	my $volume = $MUSIC_PLAYING_META->{data}{volume} || 1;
313	my $base = $MUSIC_PLAYING_META->{data}{jingle} ? 1 : $CFG->{bgm_volume};	400	my $base = $MUSIC_PLAYING_META->{data}{jingle} ? 1 : $CFG->{bgm_volume};
314	dc::MixMusic::volume $base * $volume * 128;	401	DC::MixMusic::volume $base * $volume * 128;
315	}	402	}
316		403
317	sub audio_music_start {	404	sub audio_music_start {
318	my $meta = $MUSIC_PLAYING_META;	405	my $meta = $MUSIC_PLAYING_META;
319		406
320	dc::DB::get res_data => $meta->{name}, sub {	407	DC::DB::get res_data => $meta->{name}, sub {
321	return unless $SDL_MIXER;	408	return unless $SDL_MIXER;
322		409
323	# music might have changed...	410	# music might have changed...
324	$meta eq $MUSIC_PLAYING_META	411	$meta eq $MUSIC_PLAYING_META
325	or return &audio_music_start ();	412	or return &audio_music_start ();
…		…
327	audio_music_update_volume;	414	audio_music_update_volume;
328		415
329	$MUSIC_PLAYING_DATA = \$_[0];	416	$MUSIC_PLAYING_DATA = \$_[0];
330		417
331	my $rwops = $meta->{path}	418	my $rwops = $meta->{path}
332	? new_from_file dc::RW $meta->{path}	419	? new_from_file DC::RW $meta->{path}
333	: new dc::RW $$MUSIC_PLAYING_DATA;	420	: new DC::RW $$MUSIC_PLAYING_DATA;
334		421
335	$MUSIC_PLAYER = new dc::MixMusic $rwops	422	$MUSIC_PLAYER = new DC::MixMusic $rwops
336	or Carp::confess "music face $meta->{face} unloadable: " . dc::Mix_GetError;	423	or Carp::confess "music face $meta->{face} unloadable: " . DC::Mix_GetError;
337		424
338	my $NOW = time;	425	my $NOW = time;
339		426
340	if ($MUSIC_PLAYING_META->{stop_time} > $NOW - $MUSIC_RESUME) {	427	if ($MUSIC_PLAYING_META->{stop_time} > $NOW - $MUSIC_RESUME) {
341	my $pos = $MUSIC_PLAYING_META->{stop_pos};	428	my $pos = $MUSIC_PLAYING_META->{stop_pos};
…		…
372		459
373	# randomize music a bit so that the order is not always the same	460	# randomize music a bit so that the order is not always the same
374	$_->{stop_time} ||= rand for @MUSIC_HAVE;	461	$_->{stop_time} ||= rand for @MUSIC_HAVE;
375		462
376	# default MUSIC_HAVE == MUSIC_DEFAULT	463	# default MUSIC_HAVE == MUSIC_DEFAULT
377	@MUSIC_HAVE = { path => dc::find_rcfile "music/$MUSIC_DEFAULT" }	464	@MUSIC_HAVE = { path => DC::find_rcfile "music/$MUSIC_DEFAULT" }
378	unless @MUSIC_HAVE;	465	unless @MUSIC_HAVE;
379	}	466	}
380		467
381	# if the currently playing song is acceptable, let it continue	468	# if the currently playing song is acceptable, let it continue
382	return if grep $MUSIC_PLAYING_META == $_, @MUSIC_HAVE;	469	return if grep $MUSIC_PLAYING_META == $_, @MUSIC_HAVE;
…		…
384	my $NOW = time;	471	my $NOW = time;
385		472
386	if ($MUSIC_PLAYING_META) {	473	if ($MUSIC_PLAYING_META) {
387	$MUSIC_PLAYING_META->{stop_time} = $NOW;	474	$MUSIC_PLAYING_META->{stop_time} = $NOW;
388	$MUSIC_PLAYING_META->{stop_pos} = $NOW - $MUSIC_START;	475	$MUSIC_PLAYING_META->{stop_pos} = $NOW - $MUSIC_START;
389	dc::MixMusic::fade_out $fade_out;	476	DC::MixMusic::fade_out $fade_out;
390	} else {	477	} else {
391	# sort by stop time, oldest first	478	# sort by stop time, oldest first
392	@MUSIC_HAVE = sort { $a->{stop_time} <=> $b->{stop_time} } @MUSIC_HAVE;	479	@MUSIC_HAVE = sort { $a->{stop_time} <=> $b->{stop_time} } @MUSIC_HAVE;
393		480
394	# if the most recently-played piece played very recently,	481	# if the most recently-played piece played very recently,
…		…
428	}	515	}
429		516
430	sub audio_init {	517	sub audio_init {
431	if ($CFG->{audio_enable}) {	518	if ($CFG->{audio_enable}) {
432	$ENV{MIX_EFFECTSMAXSPEED} = 1;	519	$ENV{MIX_EFFECTSMAXSPEED} = 1;
433	$SDL_MIXER = !dc::Mix_OpenAudio	520	$SDL_MIXER = !DC::Mix_OpenAudio
434	$CFG->{audio_hw_frequency},	521	$CFG->{audio_hw_frequency},
435	dc::MIX_DEFAULT_FORMAT,	522	DC::MIX_DEFAULT_FORMAT,
436	$CFG->{audio_hw_channels},	523	$CFG->{audio_hw_channels},
437	$CFG->{audio_hw_chunksize};	524	$CFG->{audio_hw_chunksize};
438		525
439	if ($SDL_MIXER) {	526	if ($SDL_MIXER) {
440	dc::Mix_AllocateChannels $CFG->{audio_mix_channels};	527	DC::Mix_AllocateChannels $CFG->{audio_mix_channels};
441		528
442	audio_music_finished;	529	audio_music_finished;
443	} else {	530	} else {
444	status "Unable to open sound device: there will be no sound";	531	status "Unable to open sound device: there will be no sound";
445	}	532	}
…		…
459	$MUSIC_WANT = [];	546	$MUSIC_WANT = [];
460	@MUSIC_JINGLE = ();	547	@MUSIC_JINGLE = ();
461	%AUDIO_PLAY = ();	548	%AUDIO_PLAY = ();
462	%AUDIO_CHUNK = ();	549	%AUDIO_CHUNK = ();
463		550
464	dc::Mix_CloseAudio if $SDL_MIXER;	551	DC::Mix_CloseAudio if $SDL_MIXER;
465	undef $SDL_MIXER;	552	undef $SDL_MIXER;
466	}	553	}
467		554
468	#############################################################################	555	#############################################################################
469		556
…		…
489		576
490	return;	577	return;
491	}	578	}
492	}	579	}
493		580
494	$conn->{query_dialog} = my $dialog = new dc::UI::Toplevel	581	$conn->{query_dialog} = my $dialog = new DC::UI::Toplevel
495	x => "center",	582	x => "center",
496	y => "center",	583	y => "center",
497	title => "Server Query",	584	title => "Server Query",
498	child => my $vbox = new dc::UI::VBox,	585	child => my $vbox = new DC::UI::VBox,
499	;	586	;
500		587
501	my @dialog = my $label = new dc::UI::Label	588	my @dialog = my $label = new DC::UI::Label
502	max_w => $::WIDTH * 0.8,	589	max_w => $::WIDTH * 0.8,
503	ellipsise => 0,	590	ellipsise => 0,
504	text => $prompt;	591	text => $prompt;
505		592
506	if ($flags & CS_QUERY_YESNO) {	593	if ($flags & CS_QUERY_YESNO) {
507	push @dialog, my $hbox = new dc::UI::HBox;	594	push @dialog, my $hbox = new DC::UI::HBox;
508		595
509	$hbox->add (new dc::UI::Button	596	$hbox->add (new DC::UI::Button
510	text => "No",	597	text => "No",
511	on_activate => sub {	598	on_activate => sub {
512	$conn->send ("reply n");	599	$conn->send ("reply n");
513	$dialog->destroy;	600	$dialog->destroy;
514	0	601	0
515	}	602	}
516	);	603	);
517	$hbox->add (new dc::UI::Button	604	$hbox->add (new DC::UI::Button
518	text => "Yes",	605	text => "Yes",
519	on_activate => sub {	606	on_activate => sub {
520	$conn->send ("reply y");	607	$conn->send ("reply y");
521	destroy_query_dialog $conn;	608	destroy_query_dialog $conn;
522	0	609	0
…		…
527		614
528	} elsif ($flags & CS_QUERY_SINGLECHAR) {	615	} elsif ($flags & CS_QUERY_SINGLECHAR) {
529	if ($prompt =~ /Now choose a character|Press any key for the next race/i) {	616	if ($prompt =~ /Now choose a character|Press any key for the next race/i) {
530	$dialog->{tooltip} = "#charcreation_focus";	617	$dialog->{tooltip} = "#charcreation_focus";
531		618
532	unshift @dialog, new dc::UI::Label	619	unshift @dialog, new DC::UI::Label
533	max_w => $::WIDTH * 0.8,	620	max_w => $::WIDTH * 0.8,
534	ellipsise => 0,	621	ellipsise => 0,
535	markup => "\nOr use your keyboard and the text entry below:\n";	622	markup => "\nOr use your keyboard and the text entry below:\n";
536		623
537	unshift @dialog, my $table = new dc::UI::Table;	624	unshift @dialog, my $table = new DC::UI::Table;
538		625
539	$table->add_at (0, 0, new dc::UI::Button	626	$table->add_at (0, 0, new DC::UI::Button
540	text => "Next Race",	627	text => "Next Race",
541	on_activate => sub {	628	on_activate => sub {
542	$conn->send ("reply n");	629	$conn->send ("reply n");
543	destroy_query_dialog $conn;	630	destroy_query_dialog $conn;
544	0	631	0
545	},	632	},
546	);	633	);
547	$table->add_at (2, 0, new dc::UI::Button	634	$table->add_at (2, 0, new DC::UI::Button
548	text => "Accept",	635	text => "Accept",
549	on_activate => sub {	636	on_activate => sub {
550	$conn->send ("reply d");	637	$conn->send ("reply d");
551	destroy_query_dialog $conn;	638	destroy_query_dialog $conn;
552	0	639	0
553	},	640	},
554	);	641	);
555		642
556	if ($conn->{chargen_race_description}) {	643	if ($conn->{chargen_race_description}) {
557	unshift @dialog, new dc::UI::Label	644	unshift @dialog, new DC::UI::Label
558	max_w => $::WIDTH * 0.8,	645	max_w => $::WIDTH * 0.8,
559	ellipsise => 0,	646	ellipsise => 0,
560	markup => "<span foreground='#ccccff'>$conn->{chargen_race_description}</span>",	647	markup => "<span foreground='#ccccff'>$conn->{chargen_race_description}</span>",
561	;	648	;
562	}	649	}
563		650
564	unshift @dialog, new dc::UI::Face	651	unshift @dialog, new DC::UI::Face
565	face => $conn->{player}{face},	652	face => $conn->{player}{face},
566	bg => [.2, .2, .2, 1],	653	bg => [.2, .2, .2, 1],
567	min_w => 64,	654	min_w => 64,
568	min_h => 64,	655	min_h => 64,
569	;	656	;
570		657
571	if ($conn->{chargen_race_title}) {	658	if ($conn->{chargen_race_title}) {
572	unshift @dialog, new dc::UI::Label	659	unshift @dialog, new DC::UI::Label
573	allign => 1,	660	allign => 1,
574	ellipsise => 0,	661	ellipsise => 0,
575	markup => "<span foreground='#ccccff' size='large'>Race: $conn->{chargen_race_title}</span>",	662	markup => "<span foreground='#ccccff' size='large'>Race: $conn->{chargen_race_title}</span>",
576	;	663	;
577	}	664	}
578		665
579	unshift @dialog, new dc::UI::Label	666	unshift @dialog, new DC::UI::Label
580	max_w => $::WIDTH * 0.4,	667	max_w => $::WIDTH * 0.4,
581	ellipsise => 0,	668	ellipsise => 0,
582	markup => (dc::Pod::section_label ui => "chargen_race"),	669	markup => (DC::Pod::section_label ui => "chargen_race"),
583	;	670	;
584		671
585	} elsif ($prompt =~ /roll new stats/) {	672	} elsif ($prompt =~ /roll new stats/) {
586	if (my $stat = delete $conn->{stat_change_with}) {	673	if (my $stat = delete $conn->{stat_change_with}) {
587	$conn->send ("reply $stat");	674	$conn->send ("reply $stat");
588	destroy_query_dialog $conn;	675	destroy_query_dialog $conn;
589	return;	676	return;
590	}	677	}
591		678
592	unshift @dialog, new dc::UI::Label	679	unshift @dialog, new DC::UI::Label
593	max_w => $::WIDTH * 0.4,	680	max_w => $::WIDTH * 0.4,
594	ellipsise => 0,	681	ellipsise => 0,
595	markup => "\nOr use your keyboard and the text entry below:\n";	682	markup => "\nOr use your keyboard and the text entry below:\n";
596		683
597	unshift @dialog, my $table = new dc::UI::Table;	684	unshift @dialog, my $table = new DC::UI::Table;
598		685
599	# left: re-roll	686	# left: re-roll
600	$table->add_at (0, 0, new dc::UI::Button	687	$table->add_at (0, 0, new DC::UI::Button
601	text => "Roll Again",	688	text => "Roll Again",
602	on_activate => sub {	689	on_activate => sub {
603	$conn->send ("reply y");	690	$conn->send ("reply y");
604	destroy_query_dialog $conn;	691	destroy_query_dialog $conn;
605	0	692	0
606	},	693	},
607	);	694	);
608		695
609	# center: swap stats	696	# center: swap stats
610	my ($sw1, $sw2) = map +(new dc::UI::Selector	697	my ($sw1, $sw2) = map +(new DC::UI::Selector
611	expand => 1,	698	expand => 1,
612	value => $_,	699	value => $_,
613	options => [	700	options => [
614	[1 => "Str", "Strength ($conn->{stat}{+CS_STAT_STR})"],	701	[1 => "Str", "Strength ($conn->{stat}{+CS_STAT_STR})"],
615	[2 => "Dex", "Dexterity ($conn->{stat}{+CS_STAT_DEX})"],	702	[2 => "Dex", "Dexterity ($conn->{stat}{+CS_STAT_DEX})"],
…		…
619	[6 => "Pow", "Power ($conn->{stat}{+CS_STAT_POW})"],	706	[6 => "Pow", "Power ($conn->{stat}{+CS_STAT_POW})"],
620	[7 => "Cha", "Charisma ($conn->{stat}{+CS_STAT_CHA})"],	707	[7 => "Cha", "Charisma ($conn->{stat}{+CS_STAT_CHA})"],
621	],	708	],
622	), 1 .. 2;	709	), 1 .. 2;
623		710
624	$table->add_at (2, 0, new dc::UI::Button	711	$table->add_at (2, 0, new DC::UI::Button
625	text => "Swap Stats",	712	text => "Swap Stats",
626	on_activate => sub {	713	on_activate => sub {
627	$conn->{stat_change_with} = $sw2->{value};	714	$conn->{stat_change_with} = $sw2->{value};
628	$conn->send ("reply $sw1->{value}");	715	$conn->send ("reply $sw1->{value}");
629	destroy_query_dialog $conn;	716	destroy_query_dialog $conn;
630	0	717	0
631	},	718	},
632	);	719	);
633	$table->add_at (2, 1, new dc::UI::HBox children => [$sw1, $sw2]);	720	$table->add_at (2, 1, new DC::UI::HBox children => [$sw1, $sw2]);
634		721
635	# right: accept	722	# right: accept
636	$table->add_at (4, 0, new dc::UI::Button	723	$table->add_at (4, 0, new DC::UI::Button
637	text => "Accept",	724	text => "Accept",
638	on_activate => sub {	725	on_activate => sub {
639	$conn->send ("reply n");	726	$conn->send ("reply n");
640	$STATS_PAGE->hide;
641	destroy_query_dialog $conn;	727	destroy_query_dialog $conn;
642	0	728	0
643	},	729	},
644	);	730	);
645		731
646	unshift @dialog, my $hbox = new dc::UI::HBox;	732	unshift @dialog, my $hbox = new DC::UI::HBox;
647	for (	733	for (
648	[Str => CS_STAT_STR],	734	[Str => CS_STAT_STR],
649	[Dex => CS_STAT_DEX],	735	[Dex => CS_STAT_DEX],
650	[Con => CS_STAT_CON],	736	[Con => CS_STAT_CON],
651	[Int => CS_STAT_INT],	737	[Int => CS_STAT_INT],
652	[Wis => CS_STAT_WIS],	738	[Wis => CS_STAT_WIS],
653	[Pow => CS_STAT_POW],	739	[Pow => CS_STAT_POW],
654	[Cha => CS_STAT_CHA],	740	[Cha => CS_STAT_CHA],
655	) {	741	) {
656	my ($name, $id) = @$_;	742	my ($name, $id) = @$_;
657	$hbox->add (new dc::UI::Label	743	$hbox->add (new DC::UI::Label
658	markup => "$conn->{stat}{$id} <span foreground='yellow'>$name</span>",	744	markup => "$conn->{stat}{$id} <span foreground='yellow'>$name</span>",
659	align => 0,
660	expand => 1,	745	expand => 1,
661	can_events => 1,	746	can_events => 1,
662	can_hover => 1,	747	can_hover => 1,
663	tooltip => "#stat_$name",	748	tooltip => "#stat_$name",
664	);	749	);
665	}	750	}
666		751
667	unshift @dialog, new dc::UI::Label	752	unshift @dialog, new DC::UI::Label
668	max_w => $::WIDTH * 0.4,	753	max_w => $::WIDTH * 0.4,
669	ellipsise => 0,	754	ellipsise => 0,
670	markup => (dc::Pod::section_label ui => "chargen_stats"),	755	markup => (DC::Pod::section_label ui => "chargen_stats"),
671	;	756	;
672	}	757	}
673		758
674	push @dialog, my $entry = new dc::UI::Entry	759	push @dialog, my $entry = new DC::UI::Entry
675	on_changed => sub {	760	on_changed => sub {
676	$conn->send ("reply $_[1]");	761	$conn->send ("reply $_[1]");
677	destroy_query_dialog $conn;	762	destroy_query_dialog $conn;
678	0	763	0
679	},	764	},
…		…
682	$entry->grab_focus;	767	$entry->grab_focus;
683		768
684	} else {	769	} else {
685	$dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";	770	$dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
686		771
687	push @dialog, my $entry = new dc::UI::Entry	772	push @dialog, my $entry = new DC::UI::Entry
688	$flags & CS_QUERY_HIDEINPUT ? (hidden => "*") : (),	773	$flags & CS_QUERY_HIDEINPUT ? (hidden => "*") : (),
689	on_activate => sub {	774	on_activate => sub {
690	$conn->send ("reply $_[1]");	775	$conn->send ("reply $_[1]");
691	destroy_query_dialog $conn;	776	destroy_query_dialog $conn;
692	0	777	0
…		…
698		783
699	$vbox->add (@dialog);	784	$vbox->add (@dialog);
700	$dialog->show;	785	$dialog->show;
701	}	786	}
702		787
703	sub start_game {	788	sub dc_connect {
704	status "logging in...";	789	my ($host, $port) = @_;
705
706	$LOGIN_BUTTON->set_text ("Logout");
707	$SETUP_DIALOG->hide;
708		790
709	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;	791	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
710		792
711	my ($host, $port) = split /:/, $PROFILE->{host};
712
713	$MAP = new dc::Map;
714
715	$CONN = eval {	793	$CONN =
716	new dc::Protocol	794	new DC::Protocol
717	host => $host,	795	host => $host,
718	port => $port || 13327,	796	port => $port,
719	user => $PROFILE->{user},	797	user => $PROFILE->{user},
720	pass => $PROFILE->{password},	798	pass => $PROFILE->{password},
721	mapw => $mapsize,	799	mapw => $mapsize,
722	maph => $mapsize,	800	maph => $mapsize,
723		801
724	client => "cfplus $dc::VERSION $] $^O",	802	client => "$DC::VERSION $] $^O",
725		803
726	map_widget => $MAPWIDGET,	804	map_widget => $MAPWIDGET,
727	statusbox => $STATUSBOX,	805	statusbox => $STATUSBOX,
728	map => $MAP,	806	map => $MAP,
729	mapmap => $MAPMAP,	807	mapmap => $MAPMAP,
730	query => \&server_query,	808	query => \&server_query,
731		809
732	setup_req => {	810	setup_req => {
733	smoothing => $CFG->{map_smoothing}*1,	811	smoothing => $CFG->{map_smoothing}*1,
734	},	812	},
		813
		814	on_connect => sub {
		815	if ($_[0]) {
		816	DC::lowdelay fileno $CONN->{fh};
		817
		818	status "login successful";
		819	} else {
		820	undef $CONN;
		821	status "unable to connect: $!";
		822	stop_game();
		823	}
		824	},
735	};	825	;
		826	}
736		827
737	if ($CONN) {	828	sub start_game {
738	dc::lowdelay fileno $CONN->{fh};	829	status "logging in...";
739		830
740	status "login successful";	831	$LOGIN_BUTTON->set_text ("Logout");
		832	$SETUP_DIALOG->hide;
		833
		834	my ($host, $port) = AnyEvent::Socket::parse_hostport $PROFILE->{host}, "deliantra=13327";
		835
		836	$MAP = new DC::Map;
		837
		838	# hack to make SURE we find the IP address all right
		839	# can be removed once AnyEvent::DNS is proven stable.
		840	if ($host eq "gameserver.deliantra.net") {
		841	AnyEvent::DNS::a "dnstest.deliantra.net", sub {
		842	if ($_[0] ne "80.101.114.108") { # Perl
		843	status "dns failure, using hardcoded address";
		844	$host = "129.13.162.95";
		845	}
		846
		847	dc_connect $host, $port;
		848	};
741	} else {	849	} else {
742	status "unable to connect";	850	dc_connect $host, $port;
743	stop_game();
744	}	851	}
745	}	852	}
746		853
747	sub stop_game {	854	sub stop_game {
		855	crash "stop_game";
		856
748	$LOGIN_BUTTON->set_text ("Login / Register");	857	$LOGIN_BUTTON->set_text ("Login / Register");
749	$SETUP_NOTEBOOK->set_current_page ($SETUP_LOGIN);	858	$SETUP_NOTEBOOK->set_current_page ($SETUP_LOGIN);
750	$SETUP_DIALOG->show;	859	$SETUP_DIALOG->show;
751	$PL_WINDOW->hide;	860	$PL_WINDOW->hide;
752	$SPELL_LIST->clear_spells;	861	$SPELL_LIST->clear_spells;
753	$dc::UI::ROOT->emit (stop_game => ! ! $CONN);	862	$DC::UI::ROOT->emit (stop_game => ! ! $CONN);
754		863
755	&audio_music_set_ambient ([]);	864	&audio_music_set_ambient ([]);
756		865
757	return unless $CONN;	866	return unless $CONN;
758		867
…		…
764		873
765	undef $MAP;	874	undef $MAP;
766	}	875	}
767		876
768	sub graphics_setup {	877	sub graphics_setup {
769	my $vbox = new dc::UI::VBox;	878	my $vbox = new DC::UI::VBox;
770		879
771	$vbox->add (my $table = new dc::UI::Table expand => 1, col_expand => [0, 1]);	880	$vbox->add (my $table = new DC::UI::Table expand => 1, col_expand => [0, 1]);
772		881
773	my $row = 0;	882	my $row = 0;
774		883
775	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "OpenGL Info");	884	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "OpenGL Info");
776	$table->add_at (1, $row++, new dc::UI::Label valign => 0, fontsize => 0.8, text => dc::OpenGL::gl_vendor . ", " . dc::OpenGL::gl_version,	885	$table->add_at (1, $row++, new DC::UI::Label fontsize => 0.8, text => DC::OpenGL::gl_vendor . ", " . DC::OpenGL::gl_version,
777	can_events => 1,	886	can_events => 1,
778	tooltip => "<tt><span size='8192'>" . (dc::OpenGL::gl_extensions) . "</span></tt>");	887	tooltip => "<tt><span size='8192'>" . (DC::OpenGL::gl_extensions) . "</span></tt>");
		888
		889	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Caveats");
		890	$table->add_at (1, $row++, $CAVEAT_LABEL = new DC::UI::Label fontsize => 0.8,
		891	can_events => 1,
		892	tooltip => "This field shows any known issues with your config or driver, such as "
		893	. "a non-accelerated display format. You can try to work around these issues "
		894	. "by selecting a different video mode, changing the settings below or "
		895	. "by installing the right driver for your graphics card.");
779		896
780	my $vidmode_tooltip =	897	my $vidmode_tooltip =
781	"<b>Video Mode.</b> The video mode to use for fullscreen (and the window size for windowed operation). "	898	"<b>Video Mode.</b> The video mode to use for fullscreen (and the window size for windowed operation). "
782	. "The format is <i>width</i> x <i>height</i> \@ <i>depth-per-channel</i> + <i>alpha-channel</i>.";	899	. "The format is <i>width</i> x <i>height</i> \@ <i>depth-per-channel</i> + <i>alpha-channel</i>.";
783		900
784	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Video Mode");	901	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Video Mode");
785	$table->add_at (1, $row++, my $hbox = new dc::UI::HBox);	902	$table->add_at (1, $row++, my $hbox = new DC::UI::HBox);
786		903
787	$hbox->add (my $mode_slider = new dc::UI::Slider	904	$hbox->add ($MODE_SLIDER = new DC::UI::Slider
788	force_w => $WIDTH * 0.1, expand => 1, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1],	905	force_w => $WIDTH * 0.1, expand => 1,
		906	range => [ ($CFG->{sdl_mode}) x 3 ],
789	tooltip => $vidmode_tooltip);	907	tooltip => $vidmode_tooltip);
790	$hbox->add (my $mode_label = new dc::UI::Label	908	$hbox->add (my $mode_label = new DC::UI::Label
791	align => 0, valign => 0, height => 0.8, template => "9999x9999@9+9",	909	height => 0.8, template => "9999x9999@9+9",
792	can_events => 1, tooltip => $vidmode_tooltip);	910	can_events => 1, tooltip => $vidmode_tooltip);
793		911
794	$mode_slider->connect (changed => sub {	912	$MODE_SLIDER->connect (changed => sub {
795	my ($self, $value) = @_;	913	my ($self, $value) = @_;
796		914
797	$CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;	915	$CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
798	$mode_label->set_text (sprintf '%dx%d@%d+%d', @{$SDL_MODES[$value]});	916	$mode_label->set_text (sprintf '%dx%d@%d+%d', @{$SDL_MODES[$value]});
799	});	917	});
800	$mode_slider->emit (changed => $mode_slider->{range}[0]);	918	$MODE_SLIDER->emit (changed => $MODE_SLIDER->{range}[0]);
801		919
802	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Fullscreen");	920	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Fullscreen");
803	$table->add_at (1, $row++, $FULLSCREEN_ENABLE = new dc::UI::CheckBox	921	$table->add_at (1, $row++, $FULLSCREEN_ENABLE = new DC::UI::CheckBox
804	state => $CFG->{fullscreen},	922	state => $CFG->{fullscreen},
805	tooltip => "Bring the client into fullscreen mode.",	923	tooltip => "Bring the client into fullscreen mode.",
806	on_changed => sub { my ($self, $value) = @_; $CFG->{fullscreen} = $value; 0 }	924	on_changed => sub { my ($self, $value) = @_; $CFG->{fullscreen} = $value; 0 }
807	);	925	);
808		926
809	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Force OpenGL 1.1");	927	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Force OpenGL 1.1");
810	$table->add_at (1, $row++, new dc::UI::CheckBox	928	$table->add_at (1, $row++, new DC::UI::CheckBox
811	state => $CFG->{force_opengl11},	929	state => $CFG->{force_opengl11},
812	tooltip => "Limit CFPlus to use OpenGL 1.1 features only. This will normally result in "	930	tooltip => "Limit Deliantra to use OpenGL 1.1 features only. This will normally result in "
813	. "higher memory usage and slower performance. It will, however, help tremendously on "	931	. "higher memory usage and slower performance. It will, however, help tremendously on "
814	. "cards that claim to support a feature but fall back to software rendering. "	932	. "cards that claim to support a feature but fall back to software rendering. "
815	. "Nvidia Geforce FX cards are known to claim features the hardware doesn't support, "	933	. "Nvidia Geforce FX cards are known to claim features the hardware doesn't support, "
816	. "but cards and drivers from other vendors (ATI) are often just as bad. <b>If you "	934	. "but cards and drivers from other vendors (ATI) are often just as bad. "
817	. "experience extremely low framerates and your card should do better, try this option.</b>",	935	. "<b>If you experience extremely low framerates and your card should do better, try this option.</b>",
818	on_changed => sub { my ($self, $value) = @_; $CFG->{force_opengl11} = $value; 0 }	936	on_changed => sub { my ($self, $value) = @_; $CFG->{force_opengl11} = $value; 0 }
819	);	937	);
820		938
821	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Compress Textures");	939	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Forbid Alpha");
822	$table->add_at (1, $row++, new dc::UI::CheckBox	940	$table->add_at (1, $row++, new DC::UI::CheckBox
		941	state => $CFG->{disable_alpha},
		942	tooltip => "Forbid off the use of the alpha channel. This makes Deliantra look a lot worse "
		943	. "by disabling a number of textures and transparency effects. Normally, these "
		944	. "effects do not cost a lot of resources, but some graphics cards might fall "
		945	. "back to etxremely slow rendering if this is enabled. If disabling this option "
		946	. "noticably improves the framerate of the client please report this! "
		947	. "<b>If you experience extremely low framerates and your card should do better, try this option.</b>",
		948	on_changed => sub {
		949	my ($self, $value) = @_;
		950	$CFG->{disable_alpha} = $value;
		951	$SDL_REINIT = 1; # SDL_SetVideoMode ignores GL attr changes
		952	0
		953	}
		954	);
		955
		956	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Compress Textures");
		957	$table->add_at (1, $row++, new DC::UI::CheckBox
823	state => $CFG->{texture_compression},	958	state => $CFG->{texture_compression},
824	tooltip => "Use texture compression. Normally this will not reduce visual quality noticable but "	959	tooltip => "Use texture compression. Normally this will not reduce visual quality noticable but "
825	. "will save a lot of memory and increase performance. The compression algorithm "	960	. "will save a lot of memory and increase performance (and also fall prey to the ever-buggy Mac OS X software renderer). "
826	. "can differ form card to card, so your mileage may vary. This setting is ignored in "	961	. "The compression algorithm can differ form card to card, so your mileage may vary. This setting is ignored in "
827	. "forced OpenGL 1.1 mode.",	962	. "forced OpenGL 1.1 mode and when using the Apple renderer.",
828	on_changed => sub { my ($self, $value) = @_; $CFG->{texture_compression} = $value; 0 }	963	on_changed => sub { my ($self, $value) = @_; $CFG->{texture_compression} = $value; 0 }
829	);	964	);
830		965
831	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Fast & Ugly");	966	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Fast & Ugly");
832	$table->add_at (1, $row++, new dc::UI::CheckBox	967	$table->add_at (1, $row++, new DC::UI::CheckBox
833	state => $CFG->{fast},	968	state => $CFG->{fast},
834	tooltip => "Lower the visual quality considerably to speed up rendering.",	969	tooltip => "Lower the visual quality considerably to speed up rendering.",
835	on_changed => sub { my ($self, $value) = @_; $CFG->{fast} = $value; 0 }	970	on_changed => sub { my ($self, $value) = @_; $CFG->{fast} = $value; 0 }
836	);	971	);
837		972
838	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "GUI Fontsize");	973	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "GUI Fontsize");
839	$table->add_at (1, $row++, new dc::UI::Slider	974	$table->add_at (1, $row++, new DC::UI::Slider
840	range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],	975	range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],
841	tooltip => "The base font size used by most GUI elements that do not have their own setting.",	976	tooltip => "The base font size used by most GUI elements that do not have their own setting.",
842	on_changed => sub { $CFG->{gui_fontsize} = $_[1]; 0 },	977	on_changed => sub { $CFG->{gui_fontsize} = $_[1]; 0 },
843	);	978	);
844		979
845	$table->add_at (1, $row++, new dc::UI::Button	980	$table->add_at (1, $row++, new DC::UI::Button
846	expand => 1, align => 0, text => "Apply",	981	expand => 1, text => "Apply",
847	tooltip => "Apply the video settings above.",	982	tooltip => "Apply the video settings above.",
848	on_activate => sub {	983	on_activate => sub {
849	video_shutdown ();	984	video_shutdown ();
850	video_init ();	985	video_init ();
851	0	986	0
852	}	987	}
853	);	988	);
854		989
		990	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Smooth Movement");
		991	$table->add_at (1, $row++, new DC::UI::CheckBox
		992	state => $CFG->{smooth_movement},
		993	tooltip => "<b>Smooth Movement</b> tries to make movement, well, smoother, but also increases the framerate. "
		994	. "If you have a very slow system, non-accelerated drivers or plain dislike smooth scrolling, "
		995	. "then disable this option. Changes take effect immdiately.",
		996	on_changed => sub { my ($self, $value) = @_; $CFG->{smooth_movement} = $value; 0 }
		997	);
		998
855	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Map Scale");	999	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Map Scale");
856	$table->add_at (1, $row++, new dc::UI::Slider	1000	$table->add_at (1, $row++, new DC::UI::Slider
857	range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],	1001	range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
858	tooltip => "Enlarge or shrink the displayed map. Changes are instant.",	1002	tooltip => "Enlarge or shrink the displayed map. Changes are instant.",
859	on_changed => sub { my ($self, $value) = @_; $CFG->{map_scale} = 2 ** $value; 0 }	1003	on_changed => sub { my ($self, $value) = @_; $CFG->{map_scale} = 2 ** $value; 0 }
860	);	1004	);
861		1005
862	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Map Smoothing");	1006	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Map Smoothing");
863	$table->add_at (1, $row++, new dc::UI::CheckBox	1007	$table->add_at (1, $row++, new DC::UI::CheckBox
864	state => $CFG->{map_smoothing},	1008	state => $CFG->{map_smoothing},
865	tooltip => "<b>Map Smoothing</b> tries to make tile borders less square. "	1009	tooltip => "<b>Map Smoothing</b> tries to make tile borders less square. "
866	. "This increases load on the graphics subsystem and works only with TRT servers. "	1010	. "This increases load on the graphics subsystem and works only with TRT servers. "
867	. "Changes take effect at next login only.",	1011	. "Changes take effect at next login only.",
868	on_changed => sub { my ($self, $value) = @_; $CFG->{map_smoothing} = $value; 0 }	1012	on_changed => sub { my ($self, $value) = @_; $CFG->{map_smoothing} = $value; 0 }
869	);	1013	);
870		1014
871	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Fog of War");	1015	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Fog of War");
872	$table->add_at (1, $row++, new dc::UI::CheckBox	1016	$table->add_at (1, $row++, new DC::UI::CheckBox
873	state => $CFG->{fow_enable},	1017	state => $CFG->{fow_enable},
874	tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",	1018	tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",
875	on_changed => sub { my ($self, $value) = @_; $CFG->{fow_enable} = $value; 0 }	1019	on_changed => sub { my ($self, $value) = @_; $CFG->{fow_enable} = $value; 0 }
876	);	1020	);
877		1021
878	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "FoW Intensity");	1022	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "FoW Intensity");
879	$table->add_at (1, $row++, new dc::UI::Slider	1023	$table->add_at (1, $row++, new DC::UI::Slider
880	range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],	1024	range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],
881	tooltip => "<b>Fog of War Lightness.</b> The higher the intensity, the lighter the Fog-of-War color. Changes are instant.",	1025	tooltip => "<b>Fog of War Lightness.</b> The higher the intensity, the lighter the Fog-of-War color. Changes are instant.",
882	on_changed => sub { my ($self, $value) = @_; $CFG->{fow_intensity} = $value; 0 }	1026	on_changed => sub { my ($self, $value) = @_; $CFG->{fow_intensity} = $value; 0 }
883	);	1027	);
884		1028
885	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Message Fontsize");	1029	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Message Fontsize");
886	$table->add_at (1, $row++, new dc::UI::Slider	1030	$table->add_at (1, $row++, new DC::UI::Slider
887	range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],	1031	range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],
888	tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant, "	1032	tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant, "
889	. "but you still need to press apply to correctly re-layout the widget.",	1033	. "but you still need to press apply to correctly re-layout the widget.",
890	on_changed => sub { $MESSAGE_WINDOW->set_fontsize ($CFG->{log_fontsize} = $_[1]); 0 },	1034	on_changed => sub { $MESSAGE_DIST->set_fontsize ($CFG->{log_fontsize} = $_[1]); 0 },
891	);	1035	);
892		1036
893	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Gauge fontsize");	1037	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Gauge fontsize");
894	$table->add_at (1, $row++, new dc::UI::Slider	1038	$table->add_at (1, $row++, new DC::UI::Slider
895	range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],	1039	range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],
896	tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.",	1040	tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.",
897	on_changed => sub {	1041	on_changed => sub {
898	$CFG->{gauge_fontsize} = $_[1];	1042	$CFG->{gauge_fontsize} = $_[1];
899	&set_gauge_window_fontsize;	1043	&set_gauge_window_fontsize;
900	0	1044	0
901	}	1045	}
902	);	1046	);
903		1047
904	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Gauge size");	1048	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Gauge size");
905	$table->add_at (1, $row++, new dc::UI::Slider	1049	$table->add_at (1, $row++, new DC::UI::Slider
906	range => [$CFG->{gauge_size}, 0.2, 0.8],	1050	range => [$CFG->{gauge_size}, 0.2, 0.8],
907	tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",	1051	tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",
908	on_changed => sub {	1052	on_changed => sub {
909	$CFG->{gauge_size} = $_[1];	1053	$CFG->{gauge_size} = $_[1];
910	$GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});	1054	$GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
…		…
917		1061
918	our $AUDIO_HW_CHUNKSIZE;	1062	our $AUDIO_HW_CHUNKSIZE;
919	our $AUDIO_INFO;	1063	our $AUDIO_INFO;
920		1064
921	sub audio_tab_update {	1065	sub audio_tab_update {
922	my ($freq, $format, $chans) = dc::Mix_QuerySpec;	1066	my ($freq, $format, $chans) = DC::Mix_QuerySpec;
923		1067
924	$AUDIO_HW_CHUNKSIZE->set_options ([	1068	$AUDIO_HW_CHUNKSIZE->set_options ([
925	[0, "default", "Use System Default"],	1069	[0, "default", "Use System Default"],
926	map {	1070	map {
927	my $ms = sprintf "%dms", 1000 * $_ / ($CFG->{audio_hw_frequency} || 22050);	1071	my $ms = sprintf "%dms", 1000 * $_ / ($CFG->{audio_hw_frequency} || 22050);
…		…
937		1081
938	$AUDIO_INFO->set_text ($text);	1082	$AUDIO_INFO->set_text ($text);
939	}	1083	}
940		1084
941	sub audio_setup {	1085	sub audio_setup {
942	my $vbox = new dc::UI::VBox;	1086	my $vbox = new DC::UI::VBox;
943		1087
944	$vbox->add (my $table = new dc::UI::Table expand => 1, col_expand => [0, 0, 1]);	1088	$vbox->add (my $table = new DC::UI::Table expand => 1, col_expand => [0, 0, 1]);
945		1089
946	my $row = 0;	1090	my $row = 0;
947		1091
948	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Audio Enable");	1092	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Audio Enable");
949	$table->add_at (1, $row++, new dc::UI::CheckBox	1093	$table->add_at (1, $row++, new DC::UI::CheckBox
950	state => $CFG->{audio_enable},	1094	state => $CFG->{audio_enable},
951	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.",	1095	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.",
952	on_changed => sub { $CFG->{audio_enable} = $_[1]; 1 }	1096	on_changed => sub { $CFG->{audio_enable} = $_[1]; 1 }
953	);	1097	);
954		1098
955	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Sound Effects");	1099	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Sound Effects");
956	$table->add_at (1, $row, new dc::UI::CheckBox	1100	$table->add_at (1, $row, new DC::UI::CheckBox
957	expand => 1, state => $CFG->{effects_enable},	1101	expand => 1, state => $CFG->{effects_enable},
958	tooltip => "If enabled, sound effects are enabled. If disabled, no sound effects will be played.",	1102	tooltip => "If enabled, sound effects are enabled. If disabled, no sound effects will be played.",
959	on_changed => sub {	1103	on_changed => sub {
960	$CFG->{effects_enable} = $_[1];	1104	$CFG->{effects_enable} = $_[1];
961	$CONN->update_fx_want if $CONN;	1105	$CONN->update_fx_want if $CONN;
962	1	1106	1
963	}	1107	}
964	);	1108	);
965	$table->add_at (2, $row++, new dc::UI::Slider	1109	$table->add_at (2, $row++, new DC::UI::Slider
966	expand => 1, range => [$CFG->{effects_volume}, 0, 1, 0, 1/128],	1110	expand => 1, range => [$CFG->{effects_volume}, 0, 1, 0, 1/128],
967	tooltip => "The relative volume of sound effects. Best audio quality is achieved if this "	1111	tooltip => "The relative volume of sound effects. Best audio quality is achieved if this "
968	. "is set highest (rightmost) and you use your operating system volume setting. Changes are instant.",	1112	. "is set highest (rightmost) and you use your operating system volume setting. Changes are instant.",
969	on_changed => sub { $CFG->{effects_volume} = $_[1]; 1 }	1113	on_changed => sub { $CFG->{effects_volume} = $_[1]; 1 }
970	);	1114	);
971		1115
972	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Background Music");	1116	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Background Music");
973	$table->add_at (1, $row, new dc::UI::CheckBox	1117	$table->add_at (1, $row, new DC::UI::CheckBox
974	expand => 1, state => $CFG->{bgm_enable},	1118	expand => 1, state => $CFG->{bgm_enable},
975	tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",	1119	tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",
976	on_changed => sub {	1120	on_changed => sub {
977	$CFG->{bgm_enable} = $_[1];	1121	$CFG->{bgm_enable} = $_[1];
978	$CONN->update_fx_want if $CONN;	1122	$CONN->update_fx_want if $CONN;
979	audio_music_push;	1123	audio_music_push;
980	1	1124	1
981	}	1125	}
982	);	1126	);
983	$table->add_at (2, $row++, new dc::UI::Slider	1127	$table->add_at (2, $row++, new DC::UI::Slider
984	expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],	1128	expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],
985	tooltip => "The volume of the background music. Changes are instant.",	1129	tooltip => "The volume of the background music. Changes are instant.",
986	on_changed => sub { $CFG->{bgm_volume} = $_[1]; audio_music_update_volume; 0 }	1130	on_changed => sub { $CFG->{bgm_volume} = $_[1]; audio_music_update_volume; 0 }
987	);	1131	);
988		1132
989	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Frequency");	1133	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Frequency");
990	$table->add_at (1, $row++, new dc::UI::Selector	1134	$table->add_at (1, $row++, new DC::UI::Selector
991	c_colspan => 2, expand => 1,	1135	c_colspan => 2, expand => 1,
992	value => $CFG->{audio_hw_frequency},	1136	value => $CFG->{audio_hw_frequency},
993	options => [	1137	options => [
994	[ 0, "default" , "Use System Default"],	1138	[ 0, "default" , "Use System Default"],
995	[11025, "11 kHz" , "11kHz (low quality)"],	1139	[11025, "11 kHz" , "11kHz (low quality)"],
…		…
1003	audio_tab_update;	1147	audio_tab_update;
1004	1	1148	1
1005	}	1149	}
1006	);	1150	);
1007		1151
1008	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Channels");	1152	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Channels");
1009	$table->add_at (1, $row++, new dc::UI::Selector	1153	$table->add_at (1, $row++, new DC::UI::Selector
1010	c_colspan => 2, expand => 1,	1154	c_colspan => 2, expand => 1,
1011	value => $CFG->{audio_hw_channels},	1155	value => $CFG->{audio_hw_channels},
1012	options => [	1156	options => [
1013	[0, "default" , "Use System Default"],	1157	[0, "default" , "Use System Default"],
1014	[1, "Mono" , "Mono (single channel, low quality)"],	1158	[1, "Mono" , "Mono (single channel, low quality)"],
…		…
1022	audio_tab_update;	1166	audio_tab_update;
1023	1	1167	1
1024	}	1168	}
1025	);	1169	);
1026		1170
1027	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Latency");	1171	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Latency");
1028	$table->add_at (1, $row++, $AUDIO_HW_CHUNKSIZE = new dc::UI::Selector	1172	$table->add_at (1, $row++, $AUDIO_HW_CHUNKSIZE = new DC::UI::Selector
1029	c_colspan => 2, expand => 1,	1173	c_colspan => 2, expand => 1,
1030	value => $CFG->{audio_hw_chunksize},	1174	value => $CFG->{audio_hw_chunksize},
1031	tooltip => "The guarenteed latency. Lower is better, but also more cpu-intensive and might cause stuttering. If music playback "	1175	tooltip => "The guarenteed latency. Lower is better, but also more cpu-intensive and might cause stuttering. If music playback "
1032	. "is stuttering, increase this value. Values of 50-100ms are optimal.",	1176	. "is stuttering, increase this value. Values of 50-100ms are optimal.",
1033	on_changed => sub {	1177	on_changed => sub {
…		…
1036	1	1180	1
1037	}	1181	}
1038	);	1182	);
1039		1183
1040	# should really be a slider	1184	# should really be a slider
1041	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Mixer Voices");	1185	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Mixer Voices");
1042	$table->add_at (1, $row++, new dc::UI::ValSlider	1186	$table->add_at (1, $row++, new DC::UI::ValSlider
1043	c_colspan => 2, expand => 1,	1187	c_colspan => 2, expand => 1,
1044	tooltip => "The number of simultaneous sound effects possible. Higher is better, but also more cpu-intensive and might cause stuttering.",	1188	tooltip => "The number of simultaneous sound effects possible. Higher is better, but also more cpu-intensive and might cause stuttering.",
1045	range => [$::CFG->{audio_mix_channels}, 4, 32, 0, 1],	1189	range => [$::CFG->{audio_mix_channels}, 4, 32, 0, 1],
1046	template => ">= 99",	1190	template => ">= 99",
1047	on_changed => sub {	1191	on_changed => sub {
…		…
1051	if $value;	1195	if $value;
1052	1;	1196	1;
1053	}	1197	}
1054	);	1198	);
1055		1199
1056	$table->add_at (1, $row++, new dc::UI::Button	1200	$table->add_at (1, $row++, new DC::UI::Button
1057	c_colspan => 2, expand => 1, align => 0, text => "Apply",	1201	c_colspan => 2, expand => 1, text => "Apply",
1058	tooltip => "Apply the audio settings",	1202	tooltip => "Apply the audio settings",
1059	on_activate => sub {	1203	on_activate => sub {
1060	audio_shutdown ();	1204	audio_shutdown ();
1061	audio_init ();	1205	audio_init ();
1062	0	1206	0
1063	}	1207	}
1064	);	1208	);
1065		1209
1066	$vbox->add (new dc::UI::FancyFrame	1210	$vbox->add (new DC::UI::FancyFrame
1067	expand => 1,	1211	expand => 1,
1068	label => "Audio Info",	1212	label => "Audio Info",
1069	child => ($AUDIO_INFO = new dc::UI::Label ellipsise => 0),	1213	child => ($AUDIO_INFO = new DC::UI::Label ellipsise => 0),
1070	);	1214	);
1071		1215
1072	audio_tab_update;	1216	audio_tab_update;
1073		1217
1074	$vbox	1218	$vbox
…		…
1081	}	1225	}
1082		1226
1083	sub make_gauge_window {	1227	sub make_gauge_window {
1084	my $gh = int $HEIGHT * $CFG->{gauge_size};	1228	my $gh = int $HEIGHT * $CFG->{gauge_size};
1085		1229
1086	my $win = new dc::UI::Frame (	1230	my $win = new DC::UI::Frame (
1087	force_x => 0,	1231	force_x => 0,
1088	force_y => "max",	1232	force_y => "max",
1089	force_w => $WIDTH,	1233	force_w => $WIDTH,
1090	force_h => $gh,	1234	force_h => $gh,
1091	);	1235	);
1092		1236
1093	$win->add (my $hbox = new dc::UI::HBox	1237	$win->add (my $hbox = new DC::UI::HBox
1094	children => [	1238	children => [
1095	(new dc::UI::HBox expand => 1),	1239	(new DC::UI::HBox expand => 1),
1096	(new dc::UI::VBox children => [	1240	(new DC::UI::VBox children => [
1097	(new dc::UI::Empty expand => 1),	1241	(new DC::UI::Empty expand => 1),
1098	(new dc::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new dc::UI::Table)),	1242	(new DC::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new DC::UI::Table)),
1099	]),	1243	]),
1100	(my $vbox = new dc::UI::VBox),	1244	(my $vbox = new DC::UI::VBox),
1101	],	1245	],
1102	);	1246	);
1103		1247
1104	$vbox->add (new dc::UI::HBox	1248	$vbox->add (new DC::UI::HBox
1105	expand => 1,	1249	expand => 1,
1106	children => [	1250	children => [
1107	(new dc::UI::Empty expand => 1),	1251	(new DC::UI::Empty expand => 1),
1108	(my $hb = new dc::UI::HBox),	1252	(my $hb = new DC::UI::HBox),
1109	],	1253	],
1110	);	1254	);
1111		1255
1112	$hb->add (my $hg = new dc::UI::Gauge type => 'hp', tooltip => "#stat_health");	1256	$hb->add (my $hg = new DC::UI::Gauge type => 'hp', tooltip => "#stat_health");
1113	$hb->add (my $mg = new dc::UI::Gauge type => 'mana', tooltip => "#stat_mana");	1257	$hb->add (my $mg = new DC::UI::Gauge type => 'mana', tooltip => "#stat_mana");
1114	$hb->add (my $gg = new dc::UI::Gauge type => 'grace', tooltip => "#stat_grace");	1258	$hb->add (my $gg = new DC::UI::Gauge type => 'grace', tooltip => "#stat_grace");
1115	$hb->add (my $fg = new dc::UI::Gauge type => 'food', tooltip => "#stat_food");	1259	$hb->add (my $fg = new DC::UI::Gauge type => 'food', tooltip => "#stat_food");
1116		1260
1117	$vbox->add (my $exp = new dc::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1, tooltip => "#stat_exp");	1261	$vbox->add (my $exp = new DC::UI::Label align => 1, can_hover => 1, can_events => 1, tooltip => "#stat_exp");
1118	$vbox->add (my $prg = new dc::UI::ExperienceProgress);	1262	$vbox->add (my $prg = new DC::UI::ExperienceProgress);
1119	$vbox->add (my $sklprg = new dc::UI::ExperienceProgress);	1263	$vbox->add (my $sklprg = new DC::UI::ExperienceProgress);
1120	$vbox->add (my $rng = new dc::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1, tooltip => "#stat_ranged");	1264	$vbox->add (my $rng = new DC::UI::Label align => 1, can_hover => 1, can_events => 1, tooltip => "#stat_ranged");
1121		1265
1122	$GAUGES = {	1266	$GAUGES = {
1123	exp => $exp, prg => $prg, sklprg => $sklprg,	1267	exp => $exp, prg => $prg, sklprg => $sklprg,
1124	win => $win, range => $rng,	1268	win => $win, range => $rng,
1125	hp => $hg, mana => $mg, grace => $gg, food => $fg,	1269	hp => $hg, mana => $mg, grace => $gg, food => $fg,
…		…
1129		1273
1130	$win	1274	$win
1131	}	1275	}
1132		1276
1133	sub debug_setup {	1277	sub debug_setup {
1134	my $table = new dc::UI::Table;	1278	my $table = new DC::UI::Table;
1135		1279
1136	$table->add_at (0, 0, new dc::UI::Label text => "Widget Borders");	1280	$table->add_at (0, 0, new DC::UI::Label text => "Widget Borders");
1137	$table->add_at (1, 0, new dc::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 1; 0 });	1281	$table->add_at (1, 0, new DC::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 1; 0 });
1138	$table->add_at (0, 1, new dc::UI::Label text => "Tooltip Widget Info");	1282	$table->add_at (0, 1, new DC::UI::Label text => "Tooltip Widget Info");
1139	$table->add_at (1, 1, new dc::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 2; 0 });	1283	$table->add_at (1, 1, new DC::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 2; 0 });
1140	$table->add_at (0, 2, new dc::UI::Label text => "Show FPS");	1284	$table->add_at (0, 2, new DC::UI::Label text => "Show FPS");
1141	$table->add_at (1, 2, new dc::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 4; 0 });	1285	$table->add_at (1, 2, new DC::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 4; 0 });
1142	$table->add_at (0, 3, new dc::UI::Label text => "Suppress Tooltips");	1286	$table->add_at (0, 3, new DC::UI::Label text => "Suppress Tooltips");
1143	$table->add_at (1, 3, new dc::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 8; 0 });	1287	$table->add_at (1, 3, new DC::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 8; 0 });
1144	$table->add_at (0, 4, new dc::UI::Button text => "die on click(tm)", on_activate => sub { &dc::debug() } );	1288	$table->add_at (0, 4, new DC::UI::Button text => "die on click(tm)", on_activate => sub { &DC::debug() } );
1145		1289
1146	$table->add_at (0, 5, new dc::UI::TextEdit text => "line1\0152\0153");#d#	1290	$table->add_at (0, 5, new DC::UI::TextEdit text => "line1\0152\0153\nµikachu\nづx゙つ゛");#d#
1147		1291
1148	$table->add_at (7,7, my $t = new dc::UI::Table expand => 0);	1292	$table->add_at (7,7, my $t = new DC::UI::Table expand => 0);
1149	$t->add_at (0,0, new dc::UI::Label text => "a a a a", c_rowspan => 1, c_colspan => 2);	1293	$t->add_at (0,0, new DC::UI::Label text => "a a", c_rowspan => 1, c_colspan => 2);
1150	$t->add_at (2,0, new dc::UI::Label text => "b\nb", c_rowspan => 2, c_colspan => 1);	1294	$t->add_at (2,0, new DC::UI::Label text => "b\nb", c_rowspan => 2, c_colspan => 1, ellipsise => 0 );
1151	$t->add_at (1,2, new dc::UI::Label text => "c c c c", c_rowspan => 1, c_colspan => 2);	1295	$t->add_at (1,2, new DC::UI::Label text => "c c", c_rowspan => 1, c_colspan => 2);
1152	$t->add_at (0,1, new dc::UI::Label text => "d\nd", c_rowspan => 2, c_colspan => 1);	1296	$t->add_at (0,1, new DC::UI::Label text => "d\nd", c_rowspan => 2, c_colspan => 1, ellipsise => 0 );
1153	$t->add_at (1,1, new dc::UI::Label text => "e");	1297	$t->add_at (1,1, new DC::UI::Label text => "e");
1154		1298
1155	$table->add_at (7, 6, my $c = new dc::UI::Canvas);	1299	$table->add_at (7, 6, my $c = new DC::UI::Canvas);
1156		1300
1157	$c->add_items ({	1301	$c->add_items ({
1158	type => "line_loop",	1302	type => "line_loop",
1159	color => [0, 1, 0],	1303	color => [0, 1, 0],
1160	width => 9,	1304	width => 9,
…		…
1180		1324
1181	$table	1325	$table
1182	}	1326	}
1183		1327
1184	sub stats_window {	1328	sub stats_window {
1185	my $r = new dc::UI::ScrolledWindow (	1329	my $r = new DC::UI::ScrolledWindow (
1186	expand => 1,	1330	expand => 1,
1187	scroll_y => 1	1331	scroll_y => 1
1188	);	1332	);
1189	$r->add (my $vb = new dc::UI::VBox);	1333	$r->add (my $vb = new DC::UI::VBox);
1190		1334
1191	$vb->add (new dc::UI::FancyFrame	1335	$vb->add (new DC::UI::FancyFrame
1192	label => "Player",	1336	label => "Player",
1193	child => (my $pi = new dc::UI::VBox),	1337	child => (my $pi = new DC::UI::VBox),
1194	);	1338	);
1195		1339
1196	$pi->add ($STATWIDS->{title} = new dc::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,	1340	$pi->add ($STATWIDS->{title} = new DC::UI::Label text => "Title:", expand => 1, align => 0,
1197	can_hover => 1, can_events => 1,	1341	can_hover => 1, can_events => 1,
1198	tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");	1342	tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");
1199	$pi->add ($STATWIDS->{map} = new dc::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,	1343	$pi->add ($STATWIDS->{map} = new DC::UI::Label align => 0, text => "Map:", expand => 1,
1200	can_hover => 1, can_events => 1,	1344	can_hover => 1, can_events => 1,
1201	tooltip => "The map you are currently on (if supported by the server).");	1345	tooltip => "The map you are currently on (if supported by the server).");
1202		1346
1203	$pi->add (my $hb0 = new dc::UI::HBox);	1347	$pi->add (my $hb0 = new DC::UI::HBox);
1204	$hb0->add ($STATWIDS->{weight} = new dc::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1,	1348	$hb0->add ($STATWIDS->{weight} = new DC::UI::Label text => "Weight:", expand => 1, align => 0,
1205	can_hover => 1, can_events => 1,	1349	can_hover => 1, can_events => 1,
1206	tooltip => "The weight of the player including all inventory items.");	1350	tooltip => "The weight of the player including all inventory items.");
1207	$hb0->add ($STATWIDS->{m_weight} = new dc::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1,	1351	$hb0->add ($STATWIDS->{m_weight} = new DC::UI::Label align => 0, text => "Max weight:", expand => 1,
1208	can_hover => 1, can_events => 1,	1352	can_hover => 1, can_events => 1,
1209	tooltip => "The weight limit: you cannot carry more than this.");	1353	tooltip => "The weight limit: you cannot carry more than this.");
1210		1354
1211	$vb->add (new dc::UI::FancyFrame	1355	$vb->add (new DC::UI::FancyFrame
1212	label => "Primary/Secondary Statistics",	1356	label => "Primary/Secondary Statistics",
1213	child => (my $hb = new dc::UI::HBox expand => 1),	1357	child => (my $hb = new DC::UI::HBox expand => 1),
1214	);	1358	);
1215	$hb->add (my $tbl = new dc::UI::Table expand => 1);	1359	$hb->add (my $tbl = new DC::UI::Table expand => 1);
1216		1360
1217	my $color2 = [1, 1, 0];	1361	my $color2 = [1, 1, 0];
1218		1362
1219	for (	1363	for (
1220	[0, 0, st_str => "Str", 30],	1364	[0, 0, st_str => "Str", 30],
…		…
1232	[2, 4, st_spd => "Spd", 10.54],	1376	[2, 4, st_spd => "Spd", 10.54],
1233	[2, 5, st_wspd => "WSp", 10.54],	1377	[2, 5, st_wspd => "WSp", 10.54],
1234	) {	1378	) {
1235	my ($col, $row, $id, $label, $template) = @$_;	1379	my ($col, $row, $id, $label, $template) = @$_;
1236		1380
1237	$tbl->add_at ($col , $row, $STATWIDS->{$id} = new dc::UI::Label	1381	$tbl->add_at ($col , $row, $STATWIDS->{$id} = new DC::UI::Label
1238	font => $FONT_FIXED, can_hover => 1, can_events => 1, valign => 0,	1382	font => $FONT_FIXED, can_hover => 1, can_events => 1,
1239	align => +1, template => $template, tooltip => "#stat_$label");	1383	align => 1, template => $template, tooltip => "#stat_$label");
1240	$tbl->add_at ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new dc::UI::Label	1384	$tbl->add_at ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new DC::UI::Label
1241	font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $color2, valign => 0,	1385	font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $color2,
1242	align => -1, text => $label, tooltip => "#stat_$label");	1386	align => 0, text => $label, tooltip => "#stat_$label");
1243	}	1387	}
1244		1388
1245	$vb->add (new dc::UI::FancyFrame	1389	$vb->add (new DC::UI::FancyFrame
1246	label => "Resistancies",	1390	label => "Resistancies",
1247	child => (my $tbl2 = new dc::UI::Table expand => 1),	1391	child => (my $tbl2 = new DC::UI::Table expand => 1, col_expand => [1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 0]),
1248	);	1392	);
1249		1393
1250	my $row = 0;	1394	my $row = 0;
1251	my $col = 0;	1395	my $col = 0;
1252		1396
…		…
1291		1435
1292	for (qw/slow holyw conf fire depl magic	1436	for (qw/slow holyw conf fire depl magic
1293	drain acid pois para deat phys	1437	drain acid pois para deat phys
1294	blind fear tund elec cold ghit/)	1438	blind fear tund elec cold ghit/)
1295	{	1439	{
1296	$tbl2->add_at ($col, $row,	1440	$tbl2->add_at ($col + 2, $row,
1297	$STATWIDS->{"res_$_"} =	1441	$STATWIDS->{"res_$_"} =
1298	new dc::UI::Label	1442	new DC::UI::Label
1299	font => $FONT_FIXED,	1443	font => $FONT_FIXED,
1300	template => "-100%",	1444	template => "-100%",
1301	align => +1,	1445	align => 1,
1302	valign => 0,
1303	can_events => 1,	1446	can_events => 1,
1304	can_hover => 1,	1447	can_hover => 1,
1305	tooltip => $resist_names{$_}->[1],	1448	tooltip => $resist_names{$_}->[1],
1306	);	1449	);
1307	$tbl2->add_at ($col + 1, $row, new dc::UI::Image	1450	$tbl2->add_at ($col + 1, $row, new DC::UI::Image
1308	font => $FONT_FIXED,	1451	font => $FONT_FIXED,
1309	can_hover => 1,	1452	can_hover => 1,
1310	can_events => 1,	1453	can_events => 1,
1311	path => "ui/resist/resist_$_.png",	1454	path => "ui/resist/resist_$_.png",
1312	tooltip => $resist_names{$_}->[1],	1455	tooltip => $resist_names{$_}->[1],
1313	);	1456	);
1314	$tbl2->add_at ($col + 2, $row, new dc::UI::Label	1457	$tbl2->add_at ($col + 0, $row, new DC::UI::Label
1315	text => $resist_names{$_}->[0],	1458	text => $resist_names{$_}->[0],
1316	font => $FONT_FIXED,	1459	font => $FONT_FIXED,
		1460	align => 1,
1317	can_hover => 1,	1461	can_hover => 1,
1318	can_events => 1,	1462	can_events => 1,
1319	tooltip => $resist_names{$_}->[1],	1463	tooltip => $resist_names{$_}->[1],
1320	);	1464	);
1321		1465
1322	$row++;	1466	$row++;
1323	if ($row % 6 == 0) {	1467	if ($row % 6 == 0) {
1324	$col += 3;	1468	$col += 4;
1325	$row = 0;	1469	$row = 0;
1326	}	1470	}
1327	}	1471	}
1328		1472
1329	#update_stats_window ({});	1473	#update_stats_window ({});
1330		1474
1331	$r	1475	$r
1332	}	1476	}
1333		1477
1334	sub skill_window {	1478	sub skill_window {
1335	my $sw = new dc::UI::ScrolledWindow (expand => 1);	1479	my $sw = new DC::UI::ScrolledWindow (expand => 1);
1336		1480
1337	$sw->add ($STATWIDS->{skill_tbl} = new dc::UI::Table expand => 1, col_expand => [0, 0, 1, .1, 0, 0, 1, .1]);	1481	$sw->add ($STATWIDS->{skill_tbl} = new DC::UI::Table expand => 1, col_expand => [0, 0, 1, .1, 0, 0, 1, .1]);
1338		1482
1339	$sw	1483	$sw
1340	}	1484	}
1341		1485
1342	sub formsep($) {	1486	sub formsep($) {
…		…
1354	return if $METASERVER_ATIME > time;	1498	return if $METASERVER_ATIME > time;
1355	$METASERVER_ATIME = time + 60;	1499	$METASERVER_ATIME = time + 60;
1356		1500
1357	my $table = $METASERVER->{table};	1501	my $table = $METASERVER->{table};
1358	$table->clear;	1502	$table->clear;
1359	$table->add_at (0, 0, my $label = new dc::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");	1503	$table->add_at (0, 0, my $label = new DC::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
1360		1504
1361	my $ok = 0;	1505	my $ok = 0;
1362		1506
1363	dc::background {	1507	DC::background {
1364	my $ua = dc::lwp_useragent;	1508	my $ua = DC::lwp_useragent;
1365		1509
1366	dc::background_msg dc::decode_json +(dc::lwp_check $ua->get ($META_SERVER))->decoded_content;	1510	DC::background_msg DC::decode_json +(DC::lwp_check $ua->get ($META_SERVER))->decoded_content;
1367	} sub {	1511	} sub {
1368	my ($msg) = @_;	1512	my ($msg) = @_;
1369	if ($msg) {	1513	if ($msg) {
1370	$table->clear;	1514	$table->clear;
1371		1515
…		…
1374	"The hostname of the server.",	1518	"The hostname of the server.",
1375	"The time this server has been running without being restarted.",	1519	"The time this server has been running without being restarted.",
1376	"Short information about this server provided by its admins.",	1520	"Short information about this server provided by its admins.",
1377	);	1521	);
1378	my @col = qw(#Users Host Uptime Version Description);	1522	my @col = qw(#Users Host Uptime Version Description);
1379	$table->add_at ($_, 0, new dc::UI::Label	1523	$table->add_at ($_, 0, new DC::UI::Label
1380	can_hover => 1, can_events => 1,	1524	can_hover => 1, can_events => 1, fg => [1, 1, 0],
1381	align => 0, fg => [1, 1, 0],
1382	text => $col[$_], tooltip => $tip[$_])	1525	text => $col[$_], tooltip => $tip[$_])
1383	for 0 .. $#col;	1526	for 0 .. $#col;
1384		1527
1385	my @align = qw(1 0 1 1 -1);	1528	my @align = qw(1 0.5 1 1 0);
1386		1529
1387	my $y = 0;	1530	my $y = 0;
1388	for my $m (@{ $msg->{servers} }) {	1531	for my $m (@{ $msg->{servers} }) {
1389	my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime, $highlight) =	1532	my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime, $highlight) =
1390	@$m{qw(ip age hostname users version description ibytes obytes uptime highlight)};	1533	@$m{qw(ip age hostname users version description ibytes obytes uptime highlight)};
…		…
1406		1549
1407	$m = [$users, $host, $uptime, $version, $desc];	1550	$m = [$users, $host, $uptime, $version, $desc];
1408		1551
1409	$y++;	1552	$y++;
1410		1553
1411	$table->add_at (scalar @$m, $y, new dc::UI::VBox children => [	1554	$table->add_at (scalar @$m, $y, new DC::UI::VBox children => [
1412	(new dc::UI::Button	1555	(new DC::UI::Button
1413	text => "Use",	1556	text => "Use",
1414	tooltip => "Put this server into the <b>Host:Port</b> field",	1557	tooltip => "Put this server into the <b>Host:Port</b> field",
1415	on_activate => sub {	1558	on_activate => sub {
1416	$HOST_ENTRY->set_text ($CFG->{profile}{default}{host} = $host);	1559	$HOST_ENTRY->set_text ($CFG->{profile}{default}{host} = $host);
1417	$METASERVER->hide;	1560	$METASERVER->hide;
1418	0	1561	0
1419	},	1562	},
1420	),	1563	),
1421	(new dc::UI::Empty expand => 1),	1564	(new DC::UI::Empty expand => 1),
1422	]);	1565	]);
1423		1566
1424	$table->add_at ($_, $y, new dc::UI::Label	1567	$table->add_at ($_, $y, new DC::UI::Label
1425	max_w => $::WIDTH * 0.4,	1568	max_w => $::WIDTH * 0.4,
1426	ellipsise => 0,	1569	ellipsise => 0,
1427	align => $align[$_],	1570	align => $align[$_],
1428	text => $m->[$_],	1571	text => $m->[$_],
1429	tooltip => $tip[$_],	1572	tooltip => $tip[$_],
…		…
1439	};	1582	};
1440		1583
1441	}	1584	}
1442		1585
1443	sub metaserver_dialog {	1586	sub metaserver_dialog {
1444	my $vbox = new dc::UI::VBox;	1587	my $vbox = new DC::UI::VBox;
1445	my $table = new dc::UI::Table;	1588	my $table = new DC::UI::Table;
1446	$vbox->add (new dc::UI::ScrolledWindow expand => 1, child => $table);	1589	$vbox->add (new DC::UI::ScrolledWindow expand => 1, child => $table);
1447		1590
1448	my $dialog = new dc::UI::Toplevel	1591	my $dialog = new DC::UI::Toplevel
1449	title => "Server List",	1592	title => "Server List",
1450	name => 'metaserver_dialog',	1593	name => 'metaserver_dialog',
1451	x => 'center',	1594	x => 'center',
1452	y => 'center',	1595	y => 'center',
1453	z => 3,	1596	z => 3,
…		…
1464		1607
1465	$dialog	1608	$dialog
1466	}	1609	}
1467		1610
1468	sub login_setup {	1611	sub login_setup {
1469	my $vbox = new dc::UI::VBox;	1612	my $vbox = new DC::UI::VBox;
1470		1613
1471	$vbox->add (new dc::UI::FancyFrame	1614	$vbox->add (new DC::UI::FancyFrame
1472	label => "Login Settings",	1615	label => "Login Settings",
1473	child => (my $table = new dc::UI::Table expand => 1, col_expand => [0, 1]),	1616	child => (my $table = new DC::UI::Table expand => 1, col_expand => [0, 1]),
1474	);	1617	);
1475		1618
1476	$table->add_at (0, 4, new dc::UI::Label valign => 0, align => 1, text => "Username");	1619	$table->add_at (0, 4, new DC::UI::Label align => 1, text => "Username");
1477	$table->add_at (1, 4, new dc::UI::Entry	1620	$table->add_at (1, 4, new DC::UI::Entry
1478	text => $CFG->{profile}{default}{user},	1621	text => $CFG->{profile}{default}{user},
1479	tooltip => "The name of your character on the server.",	1622	tooltip => "The name of your character on the server.",
1480	on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{user} = $value; 1 }	1623	on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{user} = $value; 1 }
1481	);	1624	);
1482		1625
1483	$table->add_at (0, 5, new dc::UI::Label valign => 0, align => 1, text => "Password");	1626	$table->add_at (0, 5, new DC::UI::Label align => 1, text => "Password");
1484	$table->add_at (1, 5, new dc::UI::Entry	1627	$table->add_at (1, 5, new DC::UI::Entry
1485	text => $CFG->{profile}{default}{password},	1628	text => $CFG->{profile}{default}{password},
1486	hidden => 1,	1629	hidden => 1,
1487	tooltip => "The password for your character.",	1630	tooltip => "The password for your character.",
1488	on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{password} = $value; 1 }	1631	on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{password} = $value; 1 }
1489	);	1632	);
1490		1633
1491	$table->add_at (1, 11, $LOGIN_BUTTON = new dc::UI::Button	1634	$table->add_at (1, 11, $LOGIN_BUTTON = new DC::UI::Button
1492	expand => 1,	1635	expand => 1,
1493	align => 0,
1494	text => "Login / Register",	1636	text => "Login / Register",
1495	tooltip => "This button will either login to the account configured above or register a new account.",	1637	tooltip => "This button will either login to the account configured above or register a new account.",
1496	on_activate => sub {	1638	on_activate => sub {
1497	$CONN ? stop_game	1639	$CONN ? stop_game
1498	: start_game;	1640	: start_game;
1499	1	1641	1
1500	},	1642	},
1501	);	1643	);
1502		1644
1503	$vbox->add (new dc::UI::FancyFrame	1645	$vbox->add (new DC::UI::FancyFrame
1504	label => "Registering",	1646	label => "How to Play",
1505	min_h => 200,	1647	min_h => 240,
1506	child => (new dc::UI::Label valign => -1, ellipsise => 0,	1648	child => (new DC::UI::Label valign => 0, ellipsise => 0,
1507	markup =>	1649	markup =>
		1650	"First select a suitable video resolution in the <b>Graphics</b> tab, above.\n\n"
		1651	. "Then register a new account (or use an existing one if you have one). "
1508	"To register a new account, choose a username that hasn't been taken yet and "	1652	. "To register an account, choose a username that hasn't been taken yet (just guess) and "
1509	. "try to log-in. Follow the instructions in the Log tab in the message window.",	1653	. "try to log-in. Follow the instructions in the Log tab in the message window.",
1510	),	1654	),
1511	);	1655	);
1512		1656
1513	$vbox	1657	$vbox
1514	}	1658	}
1515		1659
1516	sub server_setup {	1660	sub server_setup {
1517	my $vbox = new dc::UI::VBox;	1661	my $vbox = new DC::UI::VBox;
1518		1662
1519	$vbox->add (new dc::UI::FancyFrame	1663	$vbox->add (new DC::UI::FancyFrame
1520	label => "Connection Settings",	1664	label => "Connection Settings",
1521	child => (my $table = new dc::UI::Table expand => 1, col_expand => [0, 1]),	1665	child => (my $table = new DC::UI::Table expand => 1, col_expand => [0, 1]),
1522	);	1666	);
1523		1667
1524	my $row = 0;	1668	my $row = 0;
1525		1669
1526	$table->add_at (0, ++$row, new dc::UI::Label valign => 0, align => 1, text => "Host:Port");	1670	$table->add_at (0, ++$row, new DC::UI::Label align => 1, text => "Host:Port");
1527	{	1671	{
1528	$table->add_at (1, $row, my $vbox = new dc::UI::VBox);	1672	$table->add_at (1, $row, my $vbox = new DC::UI::VBox);
1529		1673
1530	$vbox->add (	1674	$vbox->add (
1531	$HOST_ENTRY = new dc::UI::Entry	1675	$HOST_ENTRY = new DC::UI::Entry
1532	expand => 1,	1676	expand => 1,
1533	text => $CFG->{profile}{default}{host},	1677	text => $CFG->{profile}{default}{host},
1534	tooltip => "The hostname or ip address of the Deliantra server to connect to",	1678	tooltip => "The hostname or ip address of the Deliantra server to connect to (e.g. <b>gameserver.deliantra.net</b>)",
1535	on_changed => sub {	1679	on_changed => sub {
1536	my ($self, $value) = @_;	1680	my ($self, $value) = @_;
1537	$CFG->{profile}{default}{host} = $value;	1681	$CFG->{profile}{default}{host} = $value;
1538	1	1682	1
1539	}	1683	}
1540	);	1684	);
1541		1685
1542	if (0) { #d# disabled	1686	if (0) { #d# disabled
1543	$vbox->add (new dc::UI::Button	1687	$vbox->add (new DC::UI::Button
1544	expand => 1,	1688	expand => 1,
1545	text => "Server List",	1689	text => "Server List",
1546	other => $METASERVER,	1690	other => $METASERVER,
1547	tooltip => "Show a list of available crossfire servers",	1691	tooltip => "Show a list of available Deliantra servers",
1548	on_activate => sub { $METASERVER->toggle_visibility; 0 },	1692	on_activate => sub { $METASERVER->toggle_visibility; 0 },
1549	on_visibility_change => sub { $METASERVER->hide unless $_[1]; 1 },	1693	on_visibility_change => sub { $METASERVER->hide unless $_[1]; 1 },
1550	);	1694	);
1551	}#d#	1695	}#d#
1552	}	1696	}
1553		1697
1554	$table->add_at (0, ++$row, new dc::UI::Label valign => 0, align => 1, text => "Map Size");	1698	$table->add_at (0, ++$row, new DC::UI::Label align => 1, text => "Map Size");
1555	$table->add_at (1, $row, new dc::UI::Slider	1699	$table->add_at (1, $row, new DC::UI::Slider
1556	force_w => 100,	1700	force_w => 100,
1557	range => [$CFG->{mapsize}, 10, 100, 0, 1],	1701	range => [$CFG->{mapsize}, 10, 100, 0, 1],
1558	tooltip => "This is the size of the portion of the map update the server sends you. "	1702	tooltip => "This is the size of the portion of the map update the server sends you. "
1559	. "If you set this to a high value you will be able to see further, "	1703	. "If you set this to a high value you will be able to see further, "
1560	. "but you also increase bandwidth requirements and latency. "	1704	. "but you also increase bandwidth requirements and latency. "
1561	. "This option is only used once at log-in.",	1705	. "This option is only used once at log-in.",
1562	on_changed => sub { my ($self, $value) = @_; $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 1 },	1706	on_changed => sub { my ($self, $value) = @_; $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 1 },
1563	);	1707	);
1564		1708
1565	$table->add_at (0, ++$row, new dc::UI::Label valign => 0, align => 1, text => "Output-Rate");	1709	$table->add_at (0, ++$row, new DC::UI::Label align => 1, text => "Output-Rate");
1566	$table->add_at (1, $row, new dc::UI::Entry	1710	$table->add_at (1, $row, new DC::UI::Entry
1567	text => $CFG->{output_rate},	1711	text => $CFG->{output_rate},
1568	tooltip => "The maximum bandwidth in bytes per second that the server should not exceed "	1712	tooltip => "The maximum bandwidth in bytes per second that the server should not exceed "
1569	. "when sending data. When 0 or unset, the server "	1713	. "when sending data. When 0 or unset, the server "
1570	. "default will be used, which is usually around 100kb/s. Most servers will "	1714	. "default will be used, which is usually around 100kb/s. Most servers will "
1571	. "dynamically find an optimal rate, so adjust this only when necessary.",	1715	. "dynamically find an optimal rate, so adjust this only when necessary.",
1572	on_changed => sub { $CFG->{output_rate} = $_[1]; 1 },	1716	on_changed => sub { $CFG->{output_rate} = $_[1]; 1 },
1573	);	1717	);
1574		1718
1575	$vbox->add (new dc::UI::FancyFrame	1719	$vbox->add (new DC::UI::FancyFrame
1576	label => "Server Info",	1720	label => "Server Info",
1577	child => ($SERVER_INFO = new dc::UI::Label ellipsise => 0),	1721	child => ($SERVER_INFO = new DC::UI::Label ellipsise => 0),
1578	);	1722	);
1579		1723
1580	$vbox	1724	$vbox
1581	}	1725	}
1582		1726
1583	sub client_setup {	1727	sub client_setup {
1584	my $table = new dc::UI::Table expand => 1, col_expand => [0, 1];	1728	my $table = new DC::UI::Table expand => 1, col_expand => [0, 1];
1585		1729
1586	my $row = 0;	1730	my $row = 0;
1587		1731
1588	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Tip of the day");	1732	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Tip of the day");
1589	$table->add_at (1, $row++, new dc::UI::CheckBox	1733	$table->add_at (1, $row++, new DC::UI::CheckBox
1590	state => $CFG->{show_tips},	1734	state => $CFG->{show_tips},
1591	tooltip => "Show the <b>Tip of the day</b> window at startup?",	1735	tooltip => "Show the <b>Tip of the day</b> window at startup?",
1592	on_changed => sub {	1736	on_changed => sub {
1593	my ($self, $value) = @_;	1737	my ($self, $value) = @_;
1594	$CFG->{show_tips} = $value;	1738	$CFG->{show_tips} = $value;
1595	0	1739	0
1596	}	1740	}
1597	);	1741	);
1598		1742
1599	$table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Messages Window Size");	1743	$table->add_at (0, $row, new DC::UI::Label align => 1, text => "Message Window Size");
1600	$table->add_at (1, $row++, my $saycmd = new dc::UI::Entry	1744	$table->add_at (1, $row++, my $saycmd = new DC::UI::Entry
1601	text => $CFG->{logview_max_par},	1745	text => $CFG->{logview_max_par},
1602	tooltip => "This is maximum number of messages remembered in the <b>Messages</b> window. If the server "	1746	tooltip => "This is maximum number of messages remembered in the <b>Message</b> window. If the server "
1603	. "sends more messages than this number, older messages get removed to save memory and "	1747	. "sends more messages than this number, older messages get removed to save memory and "
1604	. "computing time. A value of <b>0</b> disables this feature, but that is not recommended.",	1748	. "computing time. A value of <b>0</b> disables this feature, but that is not recommended.",
1605	on_changed => sub {	1749	on_changed => sub {
1606	my ($self, $value) = @_;	1750	my ($self, $value) = @_;
1607	$MESSAGE_WINDOW->set_max_para ($CFG->{logview_max_par} = $value*1);	1751	$MESSAGE_DIST->set_max_par ($CFG->{logview_max_par} = $value*1);
1608	0	1752	0
1609	},	1753	},
1610	);	1754	);
1611		1755
1612	$table	1756	$table
1613	}	1757	}
1614		1758
1615	sub autopickup_setup {	1759	sub autopickup_setup {
1616	my $r = new dc::UI::ScrolledWindow (	1760	my $r = new DC::UI::ScrolledWindow (
1617	expand => 1,	1761	expand => 1,
1618	scroll_y => 1	1762	scroll_y => 1
1619	);	1763	);
1620	$r->add (my $table = new dc::UI::Table	1764	$r->add (my $table = new DC::UI::Table
1621	row_expand => [0],	1765	row_expand => [0],
1622	col_expand => [0, 1, 0, 1],	1766	col_expand => [0, 1, 0, 1],
1623	);	1767	);
1624		1768
1625	for (	1769	for (
…		…
1659	["Magic Devices" => PICKUP_MAGIC_DEVICE],	1803	["Magic Devices" => PICKUP_MAGIC_DEVICE],
1660	["Ignore cursed" => PICKUP_NOT_CURSED],	1804	["Ignore cursed" => PICKUP_NOT_CURSED],
1661	["Jewelery" => PICKUP_JEWELS],	1805	["Jewelery" => PICKUP_JEWELS],
1662	["Flesh" => PICKUP_FLESH],	1806	["Flesh" => PICKUP_FLESH],
1663	],	1807	],
1664	["Weight/Value ratio", 2, 17]	1808	["Value/Weight ratio", 2, 17]
1665	)	1809	)
1666	{	1810	{
1667	my ($title, $x, $y, @bits) = @$_;	1811	my ($title, $x, $y, @bits) = @$_;
1668	$table->add_at ($x, $y, new dc::UI::Label text => $title, align => 1, fg => [1, 1, 0]);	1812	$table->add_at ($x, $y, new DC::UI::Label text => $title, align => 1, fg => [1, 1, 0]);
1669		1813
1670	for (@bits) {	1814	for (@bits) {
1671	++$y;	1815	++$y;
1672		1816
1673	my $mask = $_->[1];	1817	my $mask = $_->[1];
1674	$table->add_at ($x , $y, new dc::UI::Label text => $_->[0], align => 1, expand => 1);	1818	$table->add_at ($x , $y, new DC::UI::Label text => $_->[0], align => 1, expand => 1);
1675	$table->add_at ($x+1, $y, my $checkbox = new dc::UI::CheckBox	1819	$table->add_at ($x+1, $y, my $checkbox = new DC::UI::CheckBox
1676	state => $::CFG->{pickup} & $mask,	1820	state => $::CFG->{pickup} & $mask,
1677	on_changed => sub {	1821	on_changed => sub {
1678	my ($box, $value) = @_;	1822	my ($box, $value) = @_;
1679		1823
1680	if ($value) {	1824	if ($value) {
…		…
1691		1835
1692	${$_->[2]} = $checkbox if $_->[2];	1836	${$_->[2]} = $checkbox if $_->[2];
1693	}	1837	}
1694	}	1838	}
1695		1839
1696	$table->add_at (2, 18, new dc::UI::ValSlider	1840	$table->add_at (2, 18, new DC::UI::ValSlider
1697	range => [$::CFG->{pickup} & 0xF, 0, 16, 1, 1],	1841	range => [$::CFG->{pickup} & 0xF, 0, 16, 1, 1],
1698	template => ">= 99",	1842	template => ">= 99",
		1843	tooltip => "Pick up items whose value/weight (silver/kg) ratio is equal or higher than this setting (which is specified in gold coins).",
1699	to_value => sub { ">= " . 5 * $_[0] },	1844	to_value => sub { ">= " . 5 * $_[0] },
1700	on_changed => sub {	1845	on_changed => sub {
1701	my ($slider, $value) = @_;	1846	my ($slider, $value) = @_;
1702		1847
1703	$::CFG->{pickup} &= ~0xF;	1848	$::CFG->{pickup} &= ~0xF;
1704	$::CFG->{pickup} |= int $value	1849	$::CFG->{pickup} |= int $value
1705	if $value;	1850	if $value;
1706	1;	1851	1;
1707	});	1852	});
1708		1853
1709	$table->add_at (3, 18, new dc::UI::Button	1854	$table->add_at (3, 18, new DC::UI::Button
1710	text => "set",	1855	text => "set",
1711	on_activate => sub {	1856	on_activate => sub {
1712	$::CONN->send_command ("pickup $::CFG->{pickup}")	1857	$::CONN->send_command ("pickup $::CFG->{pickup}")
1713	if defined $::CONN;	1858	if defined $::CONN;
1714	0	1859	0
…		…
1716		1861
1717	$r	1862	$r
1718	}	1863	}
1719		1864
1720	my %SORT_ORDER = (	1865	my %SORT_ORDER = (
1721	type => undef,	1866	type => sub {
		1867	sort { $a->{type} <=> $b->{type} or $a->{name} cmp $b->{name} } @_
		1868	},
1722	mtime => sub {	1869	mtime => sub {
1723	my $NOW = time;	1870	my $NOW = time;
1724	sort {	1871	sort {
1725	my $atime = $a->{mtime} - $NOW; $atime = $atime < 5 * 60 ? int $atime / 60 : 6;	1872	my $atime = $a->{mtime} - $NOW; $atime = $atime < 5 * 60 ? int $atime / 60 : 6;
1726	my $btime = $b->{mtime} - $NOW; $btime = $btime < 5 * 60 ? int $btime / 60 : 6;	1873	my $btime = $b->{mtime} - $NOW; $btime = $btime < 5 * 60 ? int $btime / 60 : 6;
…		…
1735	or $a->{type} <=> $b->{type}	1882	or $a->{type} <=> $b->{type}
1736	} @_ },	1883	} @_ },
1737	);	1884	);
1738		1885
1739	sub inventory_widget {	1886	sub inventory_widget {
1740	my $hb = new dc::UI::HBox homogeneous => 1;	1887	my $hb = new DC::UI::HBox homogeneous => 1;
1741		1888
1742	$hb->add (my $vb1 = new dc::UI::VBox);	1889	$hb->add (my $vb1 = new DC::UI::VBox);
1743	$vb1->add (new dc::UI::Label align => 0, text => "Player");	1890	$vb1->add (new DC::UI::Label text => "Player");
1744		1891
1745	$vb1->add (my $hb1 = new dc::UI::HBox);	1892	$vb1->add (my $hb1 = new DC::UI::HBox);
1746		1893
1747	use sort 'stable';	1894	use sort 'stable';
1748		1895
1749	$hb1->add (new dc::UI::Selector	1896	$hb1->add (new DC::UI::Selector
1750	value => $::CFG->{inv_sort},	1897	value => $::CFG->{inv_sort},
1751	options => [	1898	options => [
1752	[type => "Type/Name"],	1899	[type => "Type/Name"],
1753	[mtime => "Recent/Normal/Locked"],	1900	[mtime => "Recent/Normal/Locked"],
1754	[weight => "Weight/Type"],	1901	[weight => "Weight/Type"],
…		…
1756	on_changed => sub {	1903	on_changed => sub {
1757	$::CFG->{inv_sort} = $_[1];	1904	$::CFG->{inv_sort} = $_[1];
1758	$INV->set_sort_order ($SORT_ORDER{$_[1]});	1905	$INV->set_sort_order ($SORT_ORDER{$_[1]});
1759	},	1906	},
1760	);	1907	);
1761	$hb1->add (new dc::UI::Label text => "Weight: ", align => 1, expand => 1);	1908	$hb1->add (new DC::UI::Label text => "Weight: ", align => 1, expand => 1);
1762	#TODO# update to weigh/maxweight	1909	#TODO# update to weight/maxweight
1763	$hb1->add ($STATWIDS->{i_weight} = new dc::UI::Label align => -1);	1910	$hb1->add ($STATWIDS->{i_weight} = new DC::UI::Label align => 0);
1764		1911
1765	$vb1->add (my $sw1 = new dc::UI::ScrolledWindow expand => 1, scroll_y => 1);	1912	$vb1->add (my $sw1 = new DC::UI::ScrolledWindow expand => 1, scroll_y => 1);
1766	$sw1->add ($INV = new dc::UI::Inventory);	1913	$sw1->add ($INV = new DC::UI::Inventory);
1767	$INV->set_sort_order ($SORT_ORDER{$::CFG->{inv_sort}});	1914	$INV->set_sort_order ($SORT_ORDER{$::CFG->{inv_sort}});
1768		1915
1769	$hb->add (my $vb2 = new dc::UI::VBox);	1916	$hb->add (my $vb2 = new DC::UI::VBox);
1770		1917
1771	$vb2->add ($INVR_HB = new dc::UI::HBox);	1918	$vb2->add ($INVR_HB = new DC::UI::HBox);
1772		1919
1773	$vb2->add (my $sw2 = new dc::UI::ScrolledWindow expand => 1, scroll_y => 1);	1920	$vb2->add (my $sw2 = new DC::UI::ScrolledWindow expand => 1, scroll_y => 1);
1774	$sw2->add ($INVR = new dc::UI::Inventory);	1921	$sw2->add ($INVR = new DC::UI::Inventory);
1775		1922
1776	# XXX: Call after $INVR = ... because set_opencont sets the items	1923	# XXX: Call after $INVR = ... because set_opencont sets the items
1777	dc::Protocol::set_opencont ($::CONN, 0, "Floor");	1924	DC::Protocol::set_opencont ($::CONN, 0, "Floor");
1778		1925
1779	$hb	1926	$hb
1780	}	1927	}
1781		1928
1782	sub media_window {	1929	sub media_window {
1783	my $vb = new dc::UI::VBox;	1930	my $vb = new DC::UI::VBox;
1784		1931
1785	$vb->add (new dc::UI::FancyFrame	1932	$vb->add (new DC::UI::FancyFrame
1786	label => "Currently playing music",	1933	label => "Currently playing music",
1787	child => new dc::UI::ScrolledWindow scroll_x => 1, scroll_y => 0,	1934	child => new DC::UI::ScrolledWindow scroll_x => 1, scroll_y => 0,
1788	child => ($MUSIC_PLAYING_WIDGET = new dc::UI::Label ellipsise => 0, fontsize => 0.8),	1935	child => ($MUSIC_PLAYING_WIDGET = new DC::UI::Label ellipsise => 0, fontsize => 0.8),
1789	);	1936	);
1790		1937
1791	$vb->add (new dc::UI::FancyFrame	1938	$vb->add (new DC::UI::FancyFrame
1792	label => "Other media used in this session",	1939	label => "Other media used in this session",
1793	expand => 1,	1940	expand => 1,
1794	child => ($LICENSE_WIDGET = new dc::UI::TextScroller	1941	child => ($LICENSE_WIDGET = new DC::UI::TextScroller
1795	expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4),	1942	expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4),
1796	);	1943	);
1797		1944
1798	$vb	1945	$vb
1799	}	1946	}
…		…
1808	or return;	1955	or return;
1809		1956
1810	$LICENSE_WIDGET->add_paragraph ({	1957	$LICENSE_WIDGET->add_paragraph ({
1811	fg => [1, 1, 1, 1],	1958	fg => [1, 1, 1, 1],
1812	markup => "<small>"	1959	markup => "<small>"
1813	. "<b>Name:</b> " . (dc::asxml $meta->{name}) . "\n"	1960	. "<b>Name:</b> " . (DC::asxml $meta->{name}) . "\n"
1814	. "<b>Author:</b> " . (dc::asxml $meta->{author}) . "\n"	1961	. "<b>Author:</b> " . (DC::asxml $meta->{author}) . "\n"
1815	. "<b>Source:</b> " . (dc::asxml $meta->{source}) . "\n"	1962	. "<b>Source:</b> " . (DC::asxml $meta->{source}) . "\n"
1816	. "<b>License:</b> " . (dc::asxml $meta->{license}) . "\n"	1963	. "<b>License:</b> " . (DC::asxml $meta->{license}) . "\n"
1817	. "</small>",	1964	. "</small>",
1818	});	1965	});
1819	$LICENSE_WIDGET->scroll_to_bottom;	1966	$LICENSE_WIDGET->scroll_to_bottom;
1820	}	1967	}
1821		1968
…		…
1829	$PL_WINDOW->show;	1976	$PL_WINDOW->show;
1830	}	1977	}
1831	}	1978	}
1832		1979
1833	sub player_window {	1980	sub player_window {
1834	my $plwin = $PL_WINDOW = new dc::UI::Toplevel	1981	my $plwin = $PL_WINDOW = new DC::UI::Toplevel
1835	x => "center",	1982	x => "center",
1836	y => "center",	1983	y => "center",
1837	force_w => $WIDTH * 9/10,	1984	force_w => $WIDTH * 9/10,
1838	force_h => $HEIGHT * 9/10,	1985	force_h => $HEIGHT * 9/10,
1839	title => "Player",	1986	title => "Player",
…		…
1841	has_close_button => 1	1988	has_close_button => 1
1842	;	1989	;
1843		1990
1844	my $ntb =	1991	my $ntb =
1845	$PL_NOTEBOOK =	1992	$PL_NOTEBOOK =
1846	new dc::UI::Notebook expand => 1;	1993	new DC::UI::Notebook expand => 1;
1847		1994
1848	$ntb->add_tab (	1995	$ntb->add_tab (
1849	"Statistics (F2)" => $STATS_PAGE = stats_window,	1996	"Statistics (F2)" => $STATS_PAGE = stats_window,
1850	"Shows statistics, where all your Stats and Resistances are shown."	1997	"Shows statistics, where all your Stats and Resistances are shown."
1851	);	1998	);
1852	$ntb->add_tab (	1999	$ntb->add_tab (
1853	"Skills (F3)" => $SKILL_PAGE = skill_window,	2000	"Skills (F3)" => $SKILL_PAGE = skill_window,
1854	"Shows all your Skills."	2001	"Shows all your Skills."
1855	);	2002	);
1856		2003
1857	my $spellsw = $SPELL_PAGE = new dc::UI::ScrolledWindow (expand => 1, scroll_y => 1);	2004	my $spellsw = $SPELL_PAGE = new DC::UI::ScrolledWindow (expand => 1, scroll_y => 1);
1858	$spellsw->add ($SPELL_LIST = new dc::UI::SpellList);	2005	$spellsw->add ($SPELL_LIST = new DC::UI::SpellList);
1859	$ntb->add_tab (	2006	$ntb->add_tab (
1860	"Spellbook (F4)" => $spellsw,	2007	"Spellbook (F4)" => $spellsw,
1861	"Displays all spells you have and lets you edit keyboard shortcuts for them."	2008	"Displays all spells you have and lets you edit keyboard shortcuts for them."
1862	);	2009	);
1863	$ntb->add_tab (	2010	$ntb->add_tab (
…		…
1876	$plwin->add ($ntb);	2023	$plwin->add ($ntb);
1877	$plwin	2024	$plwin
1878	}	2025	}
1879		2026
1880	sub keyboard_setup {	2027	sub keyboard_setup {
1881	dc::Macro::keyboard_setup	2028	DC::Macro::keyboard_setup
1882	}	2029	}
1883		2030
1884	sub help_window {	2031	sub help_window {
1885	my $win = new dc::UI::Toplevel	2032	my $win = new DC::UI::Toplevel
1886	x => 'center',	2033	x => 'center',
1887	y => 'center',	2034	y => 'center',
1888	z => 4,	2035	z => 4,
1889	name => 'doc_browser',	2036	name => 'doc_browser',
1890	force_w => int $WIDTH * 7/8,	2037	force_w => int $WIDTH * 7/8,
1891	force_h => int $HEIGHT * 7/8,	2038	force_h => int $HEIGHT * 7/8,
1892	title => "Help Browser",	2039	title => "Help Browser",
1893	has_close_button => 1;	2040	has_close_button => 1;
1894		2041
1895	$win->add (my $vbox = new dc::UI::VBox);	2042	$win->add (my $vbox = new DC::UI::VBox);
1896		2043
1897	$vbox->add (new dc::UI::FancyFrame	2044	$vbox->add (new DC::UI::FancyFrame
1898	label => "Navigation",	2045	label => "Navigation",
1899	child => (my $buttons = new dc::UI::HBox),	2046	child => (my $buttons = new DC::UI::HBox),
1900	);	2047	);
1901	$vbox->add (my $viewer = new dc::UI::TextScroller	2048	$vbox->add (my $viewer = new DC::UI::TextScroller
1902	expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);	2049	expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
1903		2050
1904	my @history;	2051	my @history;
1905	my @future;	2052	my @future;
1906	my $curnode;	2053	my $curnode;
…		…
1908	my $load_node; $load_node = sub {	2055	my $load_node; $load_node = sub {
1909	my ($node, $para) = @_;	2056	my ($node, $para) = @_;
1910		2057
1911	$buttons->clear;	2058	$buttons->clear;
1912		2059
1913	$buttons->add (new dc::UI::Button	2060	$buttons->add (new DC::UI::Button
1914	text => "⇤",	2061	text => "⇤",
1915	tooltip => "back to the starting page",	2062	tooltip => "back to the starting page",
1916	on_activate => sub {	2063	on_activate => sub {
1917	unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;	2064	unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
1918	unshift @future, @history;	2065	unshift @future, @history;
…		…
1920	$load_node->(@{shift @future});	2067	$load_node->(@{shift @future});
1921	},	2068	},
1922	);	2069	);
1923		2070
1924	if (@history) {	2071	if (@history) {
1925	$buttons->add (new dc::UI::Button	2072	$buttons->add (new DC::UI::Button
1926	text => "⋘",	2073	text => "⋘",
1927	tooltip => "back to <i>" . (dc::asxml dc::Pod::full_path $history[-1][0]) . "</i>",	2074	tooltip => "back to <i>" . (DC::asxml DC::Pod::full_path $history[-1][0]) . "</i>",
1928	on_activate => sub {	2075	on_activate => sub {
1929	unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;	2076	unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
1930	$load_node->(@{pop @history});	2077	$load_node->(@{pop @history});
1931	},	2078	},
1932	);	2079	);
1933	}	2080	}
1934		2081
1935	if (@future) {	2082	if (@future) {
1936	$buttons->add (new dc::UI::Button	2083	$buttons->add (new DC::UI::Button
1937	text => "⋙",	2084	text => "⋙",
1938	tooltip => "forward to <i>" . (dc::asxml dc::Pod::full_path $future[0][0]) . "</i>",	2085	tooltip => "forward to <i>" . (DC::asxml DC::Pod::full_path $future[0][0]) . "</i>",
1939	on_activate => sub {	2086	on_activate => sub {
1940	push @history, [$curnode, $viewer->current_paragraph];	2087	push @history, [$curnode, $viewer->current_paragraph];
1941	$load_node->(@{shift @future});	2088	$load_node->(@{shift @future});
1942	},	2089	},
1943	);	2090	);
1944	}	2091	}
1945		2092
1946	$buttons->add (new dc::UI::Label text => " ");	2093	$buttons->add (new DC::UI::Label text => " ");
1947		2094
1948	my @path = dc::Pod::full_path_of $node;	2095	my @path = DC::Pod::full_path_of $node;
1949	pop @path; # drop current node	2096	pop @path; # drop current node
1950		2097
1951	for my $node (@path) {	2098	for my $node (@path) {
1952	$buttons->add (new dc::UI::Button	2099	$buttons->add (new DC::UI::Button
1953	text => $node->{kw}[0],	2100	text => $node->[DC::Pod::N_KW][0],
1954	tooltip => "go to <i>" . (dc::asxml dc::Pod::full_path $node) . "</i>",	2101	tooltip => "go to <i>" . (DC::asxml DC::Pod::full_path $node) . "</i>",
1955	on_activate => sub {	2102	on_activate => sub {
1956	push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();	2103	push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
1957	$load_node->($node);	2104	$load_node->($node);
1958	},	2105	},
1959	);	2106	);
1960	$buttons->add (new dc::UI::Label text => "/");	2107	$buttons->add (new DC::UI::Label text => "/");
1961	}	2108	}
1962		2109
1963	$buttons->add (new dc::UI::Label text => $node->{kw}[0], padding_x => 4, padding_y => 4);	2110	$buttons->add (new DC::UI::Label text => $node->[DC::Pod::N_KW][0], padding_x => 4, padding_y => 4);
1964		2111
1965	$curnode = $node;	2112	$curnode = $node;
1966		2113
1967	$viewer->clear;	2114	$viewer->clear;
1968	$viewer->add_paragraph (dc::Pod::as_paragraphs dc::Pod::section_of $curnode);	2115	$viewer->add_paragraph (DC::Pod::as_paragraphs DC::Pod::section_of $curnode);
1969	$viewer->scroll_to ($para);	2116	$viewer->scroll_to ($para);
1970	};	2117	};
1971		2118
1972	$load_node->(dc::Pod::find pod => "mainpage");	2119	$load_node->(DC::Pod::find pod => "mainpage");
1973		2120
1974	$dc::Pod::goto_document = sub {	2121	$DC::Pod::goto_document = sub {
1975	my (@path) = @_;	2122	my (@path) = @_;
1976		2123
1977	push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();	2124	push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
1978		2125
1979	$load_node->((dc::Pod::find @path)[0]);	2126	$load_node->((DC::Pod::find @path)[0]);
1980	$win->show;	2127	$win->show;
1981	};	2128	};
1982		2129
1983	$win	2130	$win
1984	}	2131	}
1985		2132
1986	sub open_string_query {	2133	sub open_string_query {
1987	my ($title, $cb, $txt, $tooltip) = @_;	2134	my ($title, $cb, $txt, $tooltip) = @_;
1988	my $dialog = new dc::UI::Toplevel	2135	my $dialog = new DC::UI::Toplevel
1989	x => "center",	2136	x => "center",
1990	y => "center",	2137	y => "center",
1991	z => 50,	2138	z => 50,
1992	force_w => $WIDTH * 4/5,	2139	force_w => $WIDTH * 4/5,
1993	title => $title;	2140	title => $title;
1994		2141
1995	$dialog->add (	2142	$dialog->add (
1996	my $e = new dc::UI::Entry	2143	my $e = new DC::UI::Entry
1997	on_activate => sub { $cb->(@_); $dialog->hide; 0 },	2144	on_activate => sub { $cb->(@_); $dialog->hide; 0 },
1998	on_key_down => sub { $_[1]->{sym} == 27 and $dialog->hide; 0 },	2145	on_key_down => sub { $_[1]->{sym} == 27 and $dialog->hide; 0 },
1999	tooltip => $tooltip	2146	tooltip => $tooltip
2000	);	2147	);
2001		2148
…		…
2004	$dialog->show;	2151	$dialog->show;
2005	}	2152	}
2006		2153
2007	sub open_quit_dialog {	2154	sub open_quit_dialog {
2008	unless ($QUIT_DIALOG) {	2155	unless ($QUIT_DIALOG) {
2009	$QUIT_DIALOG = new dc::UI::Toplevel	2156	$QUIT_DIALOG = new DC::UI::Toplevel
2010	x => "center",	2157	x => "center",
2011	y => "center",	2158	y => "center",
2012	z => 50,	2159	z => 50,
2013	title => "Really Quit?",	2160	title => "Really Quit?",
2014	on_key_down => sub {	2161	on_key_down => sub {
2015	my ($dialog, $ev) = @_;	2162	my ($dialog, $ev) = @_;
2016	$ev->{sym} == 27 and $dialog->hide;	2163	$ev->{sym} == 27 and $dialog->hide;
2017	}	2164	}
2018	;	2165	;
2019		2166
2020	$QUIT_DIALOG->add (my $vb = new dc::UI::VBox expand => 1);	2167	$QUIT_DIALOG->add (my $vb = new DC::UI::VBox expand => 1);
2021		2168
2022	$vb->add (new dc::UI::Label	2169	$vb->add (new DC::UI::Label
2023	text => "You should find a savebed and apply it first!",	2170	text => "You should find a savebed and apply it first!",
2024	max_w => $WIDTH * 0.25,	2171	max_w => $WIDTH * 0.25,
2025	ellipsize => 0,	2172	ellipsize => 0,
2026	);	2173	);
2027	$vb->add (my $hb = new dc::UI::HBox expand => 1);	2174	$vb->add (my $hb = new DC::UI::HBox expand => 1);
2028	$hb->add (new dc::UI::Button	2175	$hb->add (new DC::UI::Button
2029	text => "Ok",	2176	text => "Ok",
2030	expand => 1,	2177	expand => 1,
2031	on_activate => sub { $QUIT_DIALOG->hide; 0 },	2178	on_activate => sub { $QUIT_DIALOG->hide; 0 },
2032	);	2179	);
2033	$hb->add (new dc::UI::Button	2180	$hb->add (new DC::UI::Button
2034	text => "Quit anyway",	2181	text => "Quit anyway",
2035	expand => 1,	2182	expand => 1,
2036	on_activate => sub { EV::unloop EV::UNLOOP_ALL },	2183	on_activate => sub {
		2184	crash "Quit anyway";
		2185	EV::unloop EV::UNLOOP_ALL;
		2186	},
2037	);	2187	);
2038	}	2188	}
2039		2189
2040	$QUIT_DIALOG->show;	2190	$QUIT_DIALOG->show;
2041	$QUIT_DIALOG->grab_focus;	2191	$QUIT_DIALOG->grab_focus;
2042	}	2192	}
2043		2193
2044	sub show_tip_of_the_day {	2194	sub show_tip_of_the_day {
2045	# find all tips	2195	# find all tips
2046	my @tod = dc::Pod::find tip_of_the_day => "*";	2196	my @tod = DC::Pod::find tip_of_the_day => "*";
2047		2197
2048	dc::DB::get state => "tip_of_the_day", sub {	2198	DC::DB::get state => "tip_of_the_day", sub {
2049	my ($todindex) = @_;	2199	my ($todindex) = @_;
2050	$todindex = 0 if $todindex >= @tod;	2200	$todindex = 0 if $todindex >= @tod;
2051	dc::DB::put state => tip_of_the_day => $todindex + 1, sub { };	2201	DC::DB::put state => tip_of_the_day => $todindex + 1, sub { };
2052		2202
2053	# create dialog	2203	# create dialog
2054	my $dialog;	2204	my $dialog;
2055		2205
2056	my $close = sub {	2206	my $close = sub {
2057	$dialog->destroy;	2207	$dialog->destroy;
2058	};	2208	};
2059		2209
2060	$dialog = new dc::UI::Toplevel	2210	$dialog = new DC::UI::Toplevel
2061	x => "center",	2211	x => "center",
2062	y => "center",	2212	y => "center",
2063	z => 3,	2213	z => 3,
2064	name => 'tip_of_the_day',	2214	name => 'tip_of_the_day',
2065	force_w => int $WIDTH * 4/9,	2215	force_w => int $WIDTH * 4/9,
2066	force_h => int $WIDTH * 2/9,	2216	force_h => int $WIDTH * 2/9,
2067	title => "Tip of the day #" . (1 + $todindex),	2217	title => "Tip of the day #" . (1 + $todindex),
2068	child => my $vbox = new dc::UI::VBox,	2218	child => my $vbox = new DC::UI::VBox,
2069	has_close_button => 1,	2219	has_close_button => 1,
2070	on_delete => $close,	2220	on_delete => $close,
2071	;	2221	;
2072		2222
2073	$vbox->add (my $viewer = new dc::UI::TextScroller	2223	$vbox->add (my $viewer = new DC::UI::TextScroller
2074	expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);	2224	expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
2075	$viewer->add_paragraph (dc::Pod::as_paragraphs dc::Pod::section_of $tod[$todindex]);	2225	$viewer->add_paragraph (DC::Pod::as_paragraphs DC::Pod::section_of $tod[$todindex]);
2076		2226
2077	$vbox->add (my $table = new dc::UI::Table col_expand => [0, 1]);	2227	$vbox->add (my $table = new DC::UI::Table col_expand => [0, 1]);
2078		2228
2079	$table->add_at (0, 0, new dc::UI::Button	2229	$table->add_at (0, 0, new DC::UI::Button
2080	text => "Close",	2230	text => "Close",
2081	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>.",	2231	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>.",
2082	on_activate => $close,	2232	on_activate => $close,
2083	);	2233	);
2084		2234
2085	$table->add_at (2, 0, new dc::UI::Button	2235	$table->add_at (2, 0, new DC::UI::Button
2086	text => "Next",	2236	text => "Next",
2087	tooltip => "Show the next <b>Tip of the day</b>.",	2237	tooltip => "Show the next <b>Tip of the day</b>.",
2088	on_activate => sub {	2238	on_activate => sub {
2089	$close->();	2239	$close->();
2090	&show_tip_of_the_day;	2240	&show_tip_of_the_day;
…		…
2094	$dialog->show;	2244	$dialog->show;
2095	};	2245	};
2096	}	2246	}
2097		2247
2098	sub sdl_init {	2248	sub sdl_init {
2099	dc::SDL_Init	2249	DC::SDL_Init DC::SDL_INIT_AUDIO #| DC::SDL_NOPARACHUTE
2100	and die "SDL::Init failed!\n";	2250	and die "SDL::Init failed!\n";
2101	}	2251	}
2102		2252
2103	sub video_init {	2253	sub video_init {
		2254	DC::SDL_InitSubSystem DC::SDL_INIT_VIDEO if $SDL_REINIT;
		2255	$SDL_REINIT = 0;
		2256
		2257	@SDL_MODES = DC::SDL_ListModes 8, $CFG->{disable_alpha} ? 0 : 8;
		2258	@SDL_MODES = DC::SDL_ListModes 8, 8 unless @SDL_MODES;
		2259	@SDL_MODES = DC::SDL_ListModes 5, 0 unless @SDL_MODES;
		2260	@SDL_MODES or DC::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
		2261
		2262	@SDL_MODES = sort { $a->[0] * $a->[1] <=> $b->[0] * $b->[1] } @SDL_MODES;
		2263
2104	$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;	2264	if (!defined $CFG->{sdl_mode} or $CFG->{sdl_mode} > $#SDL_MODES) {
		2265	$CFG->{sdl_mode} = 0; # lowest resolution by default
		2266
		2267	# now choose biggest mode <= 1024x768
		2268	for (0 .. $#SDL_MODES) {
		2269	if ($SDL_MODES[$_][0] * $SDL_MODES[$_][1] <= 1024 * 768) {
		2270	$CFG->{sdl_mode} = $_;
		2271	}
		2272	}
		2273	}
2105		2274
2106	my ($old_w, $old_h) = ($WIDTH, $HEIGHT);	2275	my ($old_w, $old_h) = ($WIDTH, $HEIGHT);
2107		2276
2108	($WIDTH, $HEIGHT, my ($rgb, $alpha)) = @{ $SDL_MODES[$CFG->{sdl_mode}] };	2277	($WIDTH, $HEIGHT, my ($rgb, $alpha)) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
2109	$FULLSCREEN = $CFG->{fullscreen};	2278	$FULLSCREEN = $CFG->{fullscreen};
2110	$FAST = $CFG->{fast};	2279	$FAST = $CFG->{fast};
2111		2280
		2281	# due to mac os x braindamage, we simply retry with !fullscreen in case of an error
2112	dc::SDL_SetVideoMode $WIDTH, $HEIGHT, $rgb, $alpha, $FULLSCREEN	2282	DC::SDL_SetVideoMode $WIDTH, $HEIGHT, $rgb, $alpha, $FULLSCREEN
		2283	or DC::SDL_SetVideoMode $WIDTH, $HEIGHT, $rgb, $alpha, !$FULLSCREEN
2113	or die "SDL_SetVideoMode failed: " . (dc::SDL_GetError) . "\n";	2284	or die "SDL_SetVideoMode failed: " . (DC::SDL_GetError) . "\n";
2114		2285
2115	$SDL_ACTIVE = 1;	2286	$SDL_ACTIVE = 1;
2116	$LAST_REFRESH = time - 0.01;	2287	$LAST_REFRESH = time - 0.01;
2117		2288
2118	dc::OpenGL::init;	2289	DC::OpenGL::init;
2119	dc::Macro::init;	2290	DC::Macro::init;
2120		2291
2121	$FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};	2292	$FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
2122		2293
2123	$dc::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#	2294	$DC::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
2124		2295
2125	#############################################################################	2296	#############################################################################
2126		2297
2127	if ($DEBUG_STATUS) {	2298	if ($DEBUG_STATUS) {
2128	dc::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;	2299	DC::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
2129	} else {	2300	} else {
2130	# create/configure the widgets	2301	# create/configure the widgets
2131		2302
2132	$dc::UI::ROOT->connect (key_down => sub {	2303	$DC::UI::ROOT->connect (key_down => sub {
2133	my (undef, $ev) = @_;	2304	my (undef, $ev) = @_;
2134		2305
2135	if (my @macros = dc::Macro::find $ev) {	2306	if (my @macros = DC::Macro::find $ev) {
2136	dc::Macro::execute $_ for @macros;	2307	DC::Macro::execute $_ for @macros;
2137		2308
2138	return 1;	2309	return 1;
2139	}	2310	}
2140		2311
2141	0	2312	0
2142	});	2313	});
2143		2314
2144	$DEBUG_STATUS = new dc::UI::Label	2315	$DEBUG_STATUS = new DC::UI::Label
2145	padding => 0,	2316	padding => 0,
2146	z => 100,	2317	z => 100,
2147	force_x => "max",	2318	force_x => "max",
2148	force_y => 0;	2319	force_y => 0;
2149	$DEBUG_STATUS->show;	2320	$DEBUG_STATUS->show;
2150		2321
2151	$STATUSBOX = new dc::UI::Statusbox;	2322	$STATUSBOX = new DC::UI::Statusbox;
2152	$STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);
2153		2323
		2324	$MODBOX = new DC::UI::Label
		2325	can_events => 1,
		2326	can_hover => 1,
		2327	markup => "",
		2328	align => 0,
		2329	font => $FONT_FIXED,
		2330	tooltip => "#modifier_box",
		2331	tooltip_width => 0.67,
		2332	;
		2333
		2334	update_modbox;
		2335
2154	(new dc::UI::Frame	2336	(new DC::UI::Frame
2155	bg => [0, 0, 0, 0.4],	2337	bg => [0, 0, 0, 0.4],
2156	force_x => 0,	2338	force_x => 0,
2157	force_y => "max",	2339	force_y => "max",
2158	child => $STATUSBOX,	2340	child => (my $LR = new DC::UI::VBox),
2159	)->show;	2341	)->show;
2160		2342
		2343	$LR->add ($STATUSBOX);
		2344	$LR->add ($MODBOX);
		2345	$LR->add (new DC::UI::Label
		2346	align => 0,
		2347	markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode",
		2348	fontsize => 0.5,
		2349	fg => [1, 1, 0, 0.7],
		2350	);
		2351
2161	dc::UI::Toplevel->new (	2352	DC::UI::Toplevel->new (
2162	title => "Minimap",	2353	title => "Minimap",
2163	name => "mapmap",	2354	name => "mapmap",
2164	x => 0,	2355	x => 0,
2165	y => $FONTSIZE + 8,	2356	y => $FONTSIZE + 8,
2166	border_bg => [1, 1, 1, 192/255],	2357	border_bg => [1, 1, 1, 192/255],
2167	bg => [1, 1, 1, 0],	2358	bg => [1, 1, 1, 0],
2168	child => ($MAPMAP = new dc::MapWidget::MapMap	2359	child => ($MAPMAP = new DC::MapWidget::MapMap
2169	tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",	2360	tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
2170	),	2361	),
2171	)->show;	2362	)->show;
2172		2363
2173	$MAPWIDGET = new dc::MapWidget;	2364	$MAPWIDGET = new DC::MapWidget;
2174	$MAPWIDGET->connect (activate_console => sub {	2365	$MAPWIDGET->connect (activate_console => sub {
2175	my ($mapwidget, $preset) = @_;	2366	my ($mapwidget, $preset) = @_;
2176		2367
2177	$MESSAGE_WINDOW->activate_console ($preset)	2368	$MESSAGE_DIST->activate_console ($preset)
2178	if $MESSAGE_WINDOW;	2369	if $MESSAGE_DIST;
2179	});	2370	});
2180	$MAPWIDGET->show;	2371	$MAPWIDGET->show;
2181	$MAPWIDGET->grab_focus;	2372	$MAPWIDGET->grab_focus;
2182		2373
2183	$COMPLETER = new dc::MapWidget::Command::	2374	$COMPLETER = new DC::MapWidget::Command::
2184	command => { },	2375	command => { },
2185	tooltip => "#completer_help",	2376	tooltip => "#completer_help",
2186	;	2377	;
2187		2378
2188	$SETUP_DIALOG = new dc::UI::Toplevel	2379	$SETUP_DIALOG = new DC::UI::Toplevel
2189	title => "Setup",	2380	title => "Setup",
2190	name => "setup_dialog",	2381	name => "setup_dialog",
2191	x => 'center',	2382	x => 'center',
2192	y => 'center',	2383	y => 'center',
2193	z => 2,	2384	z => 2,
…		…
2195	force_h => $::HEIGHT * 0.6,	2386	force_h => $::HEIGHT * 0.6,
2196	has_close_button => 1,	2387	has_close_button => 1,
2197	;	2388	;
2198		2389
2199	$METASERVER = metaserver_dialog;	2390	$METASERVER = metaserver_dialog;
2200	$MESSAGE_WINDOW = new dc::UI::MessageWindow;	2391	# the name is changed to not conflict with the older name as users could have hidden it
		2392	$MESSAGE_WINDOW = new DC::UI::Dockbar
		2393	name => "message_window2",
		2394	title => 'Messages',
		2395	force_w => $::WIDTH * 0.6,
		2396	force_h => $::HEIGHT * 0.25,
		2397	;
2201		2398
		2399	$MESSAGE_DIST = new DC::MessageDistributor dockbar => $MESSAGE_WINDOW;
		2400
2202	$SETUP_DIALOG->add ($SETUP_NOTEBOOK = new dc::UI::Notebook expand => 1, debug => 1,	2401	$SETUP_DIALOG->add ($SETUP_NOTEBOOK = new DC::UI::Notebook expand => 1,
2203	filter => new dc::UI::ScrolledWindow expand => 1, scroll_y => 1);	2402	filter => new DC::UI::ScrolledWindow expand => 1, scroll_y => 1);
2204		2403
2205	$SETUP_NOTEBOOK->add_tab (Login => $SETUP_LOGIN = login_setup,	2404	$SETUP_NOTEBOOK->add_tab (Login => $SETUP_LOGIN = login_setup,
2206	"Configure the server to play on, your username and password.");	2405	"Configure the server to play on, your username and password.");
2207	$SETUP_NOTEBOOK->add_tab (Server => $SETUP_SERVER = server_setup,	2406	$SETUP_NOTEBOOK->add_tab (Server => $SETUP_SERVER = server_setup,
2208	"Configure other server related options.");	2407	"Configure other server related options.");
…		…
2220	. "After pressing the combo the binding will be saved automatically and the "	2419	. "After pressing the combo the binding will be saved automatically and the "
2221	. "binding editor closes");	2420	. "binding editor closes");
2222	$SETUP_NOTEBOOK->add_tab (Debug => debug_setup,	2421	$SETUP_NOTEBOOK->add_tab (Debug => debug_setup,
2223	"Some debuggin' options. Do not ask.");	2422	"Some debuggin' options. Do not ask.");
2224		2423
2225	$BUTTONBAR = new dc::UI::Buttonbar x => 0, y => 0, z => 200; # put on top	2424	$BUTTONBAR = new DC::UI::Buttonbar x => 0, y => 0, z => 200; # put on top
2226		2425
2227	$BUTTONBAR->add (new dc::UI::Flopper text => "Setup", other => $SETUP_DIALOG,	2426	$BUTTONBAR->add (new DC::UI::Flopper text => "Setup", other => $SETUP_DIALOG,
2228	tooltip => "Toggles a dialog where you can configure all aspects of this client.");	2427	tooltip => "Toggles a dialog where you can configure all aspects of this client.");
2229		2428
2230	$BUTTONBAR->add (new dc::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW,	2429	# $BUTTONBAR->add (new DC::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW,
2231	tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");	2430	# tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
2232		2431
2233	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	2432	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
2234		2433
2235	$BUTTONBAR->add (new dc::UI::Flopper text => "Playerbook", other => player_window,	2434	$BUTTONBAR->add (new DC::UI::Flopper text => "Playerbook", other => player_window,
2236	tooltip => "Toggles the player view, where you can manage Inventory, Spells, Skills and see your Stats.");	2435	tooltip => "Toggles the player view, where you can manage Inventory, Spells, Skills and see your Stats.");
2237		2436
2238	$BUTTONBAR->add (new dc::UI::Button	2437	$BUTTONBAR->add (new DC::UI::Button
2239	text => "Save Config",	2438	text => "Save Config",
2240	tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",	2439	tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
2241	on_activate => sub {	2440	on_activate => sub {
2242	$::CFG->{layout} = dc::UI::get_layout;	2441	$::CFG->{layout} = DC::UI::get_layout;
2243	dc::write_cfg "$Deliantra::VARDIR/client.cf";	2442	DC::write_cfg;
2244	status "Configuration Saved";	2443	status "Configuration Saved";
2245	0	2444	0
2246	},	2445	},
2247	);	2446	);
2248		2447
2249	$BUTTONBAR->add (new dc::UI::Flopper text => "Help!", other => $HELP_WINDOW = help_window,	2448	$BUTTONBAR->add (new DC::UI::Flopper text => "Help!", other => $HELP_WINDOW = help_window,
2250	tooltip => "View Documentation");	2449	tooltip => "View Documentation");
2251		2450
2252
2253	$BUTTONBAR->add (new dc::UI::Button	2451	$BUTTONBAR->add (new DC::UI::Button
2254	text => "Quit",	2452	text => "Quit",
2255	tooltip => "Terminates the program",	2453	tooltip => "Terminates the program",
2256	on_activate => sub {	2454	on_activate => sub {
2257	if ($CONN) {	2455	if ($CONN) {
2258	open_quit_dialog;	2456	open_quit_dialog;
…		…
2266	$BUTTONBAR->show;	2464	$BUTTONBAR->show;
2267	$SETUP_DIALOG->show;	2465	$SETUP_DIALOG->show;
2268	$MESSAGE_WINDOW->show;	2466	$MESSAGE_WINDOW->show;
2269	}	2467	}
2270		2468
		2469	$MODE_SLIDER->set_range ([$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1, 1]);
		2470	$MODE_SLIDER->emit (changed => $CFG->{sdl_mode});
		2471
		2472	$CAVEAT_LABEL->set_text ("None :)");
		2473	$CAVEAT_LABEL->set_text ("Software Rendering (very slow)")
		2474	unless DC::SDL_GL_GetAttribute DC::SDL_GL_ACCELERATED_VISUAL;
		2475
2271	$STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);	2476	$STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
2272	}	2477	}
2273		2478
2274	sub video_shutdown {	2479	sub video_shutdown {
2275	dc::OpenGL::shutdown;	2480	DC::OpenGL::shutdown;
		2481	DC::SDL_QuitSubSystem DC::SDL_INIT_VIDEO if $SDL_REINIT;
2276		2482
2277	undef $SDL_ACTIVE;	2483	undef $SDL_ACTIVE;
2278	}	2484	}
2279		2485
2280	my %animate_object;	2486	my %animate_object;
…		…
2289	}	2495	}
2290		2496
2291	undef $WANT_REFRESH;	2497	undef $WANT_REFRESH;
2292	$_[0]->stop;	2498	$_[0]->stop;
2293		2499
2294	$dc::UI::ROOT->draw;	2500	$DC::UI::ROOT->draw;
2295	dc::SDL_GL_SwapBuffers;	2501	DC::SDL_GL_SwapBuffers;
2296	$LAST_REFRESH = $NOW;	2502	$LAST_REFRESH = $NOW;
2297	}	2503	}
2298		2504
2299	my $want_refresh = EV::idle_ns \&force_refresh;	2505	my $want_refresh = EV::prepare_ns \&force_refresh;
2300		2506
2301	my $input = EV::periodic 0, 1/60, undef, sub {	2507	my $input = EV::periodic 0, 1 / $MAX_FPS, undef, sub {
2302	$NOW = time;	2508	$NOW = EV::now;
2303		2509
2304	($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)	2510	($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
2305	for dc::poll_events;	2511	for DC::poll_events;
2306		2512
2307	if (%animate_object) {	2513	if (%animate_object) {
2308	$_->animate ($LAST_REFRESH - $NOW) for values %animate_object;	2514	$_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
2309	$WANT_REFRESH = 1;	2515	$WANT_REFRESH = 1;
2310	}	2516	}
…		…
2322	my ($widget) = @_;	2528	my ($widget) = @_;
2323	delete $animate_object{$widget};	2529	delete $animate_object{$widget};
2324	}	2530	}
2325		2531
2326	%SDL_CB = (	2532	%SDL_CB = (
2327	dc::SDL_QUIT => sub {	2533	DC::SDL_QUIT => sub {
		2534	crash "SDL_QUIT";
2328	EV::unloop EV::UNLOOP_ALL;	2535	EV::unloop EV::UNLOOP_ALL;
2329	},	2536	},
2330	dc::SDL_VIDEORESIZE => sub {	2537	DC::SDL_VIDEORESIZE => sub {
2331	},	2538	},
2332	dc::SDL_VIDEOEXPOSE => sub {	2539	DC::SDL_VIDEOEXPOSE => sub {
2333	dc::UI::full_refresh;	2540	DC::UI::full_refresh;
2334	},	2541	},
2335	dc::SDL_ACTIVEEVENT => sub {	2542	DC::SDL_ACTIVEEVENT => sub {
2336	# not useful, as APPACTIVE includes only iconified state, not unmapped	2543	# not useful, as APPACTIVE includes only iconified state, not unmapped
2337	# printf "active %x %x %x\n", $_[0]{gain}, $_[0]{state}, dc::SDL_GetAppState;#d#	2544	# printf "active %x %x %x\n", $_[0]{gain}, $_[0]{state}, DC::SDL_GetAppState;#d#
2338	# printf "a %x\n", dc::SDL_GetAppState & dc::SDL_APPACTIVE;#d#	2545	# printf "a %x\n", DC::SDL_GetAppState & DC::SDL_APPACTIVE;#d#
2339	# printf "A\n" if $_[0]{state} & dc::SDL_APPACTIVE;	2546	# printf "A\n" if $_[0]{state} & DC::SDL_APPACTIVE;
2340	# printf "K\n" if $_[0]{state} & dc::SDL_APPINPUTFOCUS;	2547	# printf "K\n" if $_[0]{state} & DC::SDL_APPINPUTFOCUS;
2341	# printf "M\n" if $_[0]{state} & dc::SDL_APPMOUSEFOCUS;	2548	# printf "M\n" if $_[0]{state} & DC::SDL_APPMOUSEFOCUS;
2342	},	2549	},
2343	dc::SDL_KEYDOWN => sub {	2550	DC::SDL_KEYDOWN => sub {
2344	if ($_[0]{mod} & dc::KMOD_ALT && $_[0]{sym} == 13) {	2551	if ($_[0]{mod} & DC::KMOD_ALT && $_[0]{sym} == 13) {
2345	# alt-enter	2552	# alt-enter
		2553	video_shutdown;
2346	$FULLSCREEN_ENABLE->toggle;	2554	$FULLSCREEN_ENABLE->toggle;
2347	video_shutdown;
2348	video_init;	2555	video_init;
2349	} else {	2556	} else {
2350	dc::UI::feed_sdl_key_down_event ($_[0]);	2557	&DC::UI::feed_sdl_key_down_event;
2351	}	2558	}
		2559	update_modbox;
2352	},	2560	},
2353	dc::SDL_KEYUP => \&dc::UI::feed_sdl_key_up_event,	2561	DC::SDL_KEYUP => sub {
		2562	&DC::UI::feed_sdl_key_up_event;
		2563	update_modbox;
		2564	},
2354	dc::SDL_MOUSEMOTION => \&dc::UI::feed_sdl_motion_event,	2565	DC::SDL_MOUSEMOTION => \&DC::UI::feed_sdl_motion_event,
2355	dc::SDL_MOUSEBUTTONDOWN => \&dc::UI::feed_sdl_button_down_event,	2566	DC::SDL_MOUSEBUTTONDOWN => \&DC::UI::feed_sdl_button_down_event,
2356	dc::SDL_MOUSEBUTTONUP => \&dc::UI::feed_sdl_button_up_event,	2567	DC::SDL_MOUSEBUTTONUP => \&DC::UI::feed_sdl_button_up_event,
2357	dc::SDL_USEREVENT => sub {	2568	DC::SDL_USEREVENT => sub {
2358	if ($_[0]{code} == 1) {	2569	if ($_[0]{code} == 1) {
2359	audio_channel_finished $_[0]{data1};	2570	audio_channel_finished $_[0]{data1};
2360	} elsif ($_[0]{code} == 0) {	2571	} elsif ($_[0]{code} == 0) {
2361	audio_music_finished;	2572	audio_music_finished;
2362	}	2573	}
…		…
2368	$SIG{INT} = $SIG{TERM} = sub {	2579	$SIG{INT} = $SIG{TERM} = sub {
2369	EV::unloop;	2580	EV::unloop;
2370	#d# TODO calling exit here hangs the process in some futex	2581	#d# TODO calling exit here hangs the process in some futex
2371	};	2582	};
2372		2583
2373	{	2584	# due to mac os x + sdl combined briandamage, we need this contortion
		2585	sub main {
		2586	{
		2587	DC::Pod::load_docwiki DC::find_rcfile "docwiki.pst";
		2588
2374	if (-e "$Deliantra::VARDIR/client.cf") {	2589	if (-e "$Deliantra::VARDIR/client.cf") {
2375	dc::read_cfg "$Deliantra::VARDIR/client.cf";	2590	DC::read_cfg "$Deliantra::VARDIR/client.cf";
2376	} else {	2591	} else {
2377	#TODO: compatibility cruft	2592	#TODO: compatibility cruft
2378	dc::read_cfg "$Deliantra::OLDDIR/cfplusrc";	2593	DC::read_cfg "$Deliantra::OLDDIR/cfplusrc";
2379	print STDERR "INFO: used old configuratrion file\n";	2594	print STDERR "INFO: used old configuration file\n";
2380	}	2595	}
2381		2596
2382	dc::DB::Server::run;	2597	DC::DB::Server::run;
2383		2598
		2599	if ($CFG->{db_schema} < 1) {
		2600	warn "INFO: upgrading database schema from 0 to 1, mapcache and tilecache will be lost\n";
		2601	DC::DB::nuke_db;
		2602	$CFG->{db_schema} = 1;
		2603	DC::write_cfg;
		2604	}
		2605
		2606	DC::DB::open_db;
		2607
2384	dc::UI::set_layout ($::CFG->{layout});	2608	DC::UI::set_layout ($::CFG->{layout});
2385		2609
2386	my %DEF_CFG = (	2610	my %DEF_CFG = (
2387	sdl_mode => 0,	2611	sdl_mode => undef,
2388	fullscreen => 1,	2612	fullscreen => 1,
2389	fast => 0,	2613	fast => 0,
2390	force_opengl11 => undef,	2614	force_opengl11 => undef,
		2615	disable_alpha => 0,
		2616	smooth_movement => 1,
2391	texture_compression => 1,	2617	texture_compression => 1,
2392	map_scale => 1,	2618	map_scale => 1,
2393	fow_enable => 1,	2619	fow_enable => 1,
2394	fow_intensity => 0,	2620	fow_intensity => 0,
2395	map_smoothing => 1,	2621	map_smoothing => 1,
2396	gui_fontsize => 1,	2622	gui_fontsize => 1,
2397	log_fontsize => 0.7,	2623	log_fontsize => 0.7,
2398	gauge_fontsize => 1,	2624	gauge_fontsize => 1,
2399	gauge_size => 0.35,	2625	gauge_size => 0.35,
2400	stat_fontsize => 0.7,	2626	stat_fontsize => 0.7,
2401	mapsize => 100,	2627	mapsize => 100,
2402	audio_enable => 1,	2628	audio_enable => 1,
2403	audio_hw_channels => 0,	2629	audio_hw_channels => 0,
2404	audio_hw_frequency => 0,	2630	audio_hw_frequency => 0,
2405	audio_hw_chunksize => 0,	2631	audio_hw_chunksize => 0,
2406	audio_mix_channels => 8,	2632	audio_mix_channels => 8,
2407	effects_enable => 1,	2633	effects_enable => 1,
2408	effects_volume => 1,	2634	effects_volume => 1,
2409	bgm_enable => 1,	2635	bgm_enable => 1,
2410	bgm_volume => 0.5,	2636	bgm_volume => 0.5,
2411	output_rate => "",	2637	output_rate => "",
2412	pickup => 0,	2638	pickup => 0,
2413	inv_sort => "mtime",	2639	inv_sort => "mtime",
2414	default => "profile", # default profile	2640	default => "profile", # default profile
2415	show_tips => 1,	2641	show_tips => 1,
2416	logview_max_par => 1000,	2642	logview_max_par => 1000,
		2643	shift_fire_stop => 0,
2417	);	2644	);
2418		2645
2419	while (my ($k, $v) = each %DEF_CFG) {	2646	while (my ($k, $v) = each %DEF_CFG) {
2420	$CFG->{$k} = $v unless exists $CFG->{$k};	2647	$CFG->{$k} = $v unless exists $CFG->{$k};
2421	}	2648	}
2422		2649
2423	$CFG->{profile}{default}{host} ||= "gameserver.deliantra.net";	2650	$CFG->{profile}{default}{host} ||= "gameserver.deliantra.net";
2424	$PROFILE = $CFG->{profile}{default};	2651	$PROFILE = $CFG->{profile}{default};
2425		2652
2426	# convert old bindings (only default profile matters)	2653	# convert old bindings (only default profile matters)
2427	if (my $bindings = delete $PROFILE->{bindings}) {	2654	if (my $bindings = delete $PROFILE->{bindings}) {
2428	while (my ($mod, $syms) = each %$bindings) {	2655	while (my ($mod, $syms) = each %$bindings) {
2429	while (my ($sym, $cmds) = each %$syms) {	2656	while (my ($sym, $cmds) = each %$syms) {
2430	push @{ $PROFILE->{macro} }, {	2657	push @{ $PROFILE->{macro} }, {
2431	accelkey => [$mod*1, $sym*1],	2658	accelkey => [$mod*1, $sym*1],
2432	action => $cmds,	2659	action => $cmds,
		2660	};
2433	};	2661	}
2434	}	2662	}
2435	}	2663	}
2436	}
2437		2664
2438	sdl_init;	2665	sdl_init;
2439		2666
2440	@SDL_MODES = dc::SDL_ListModes 8, 8;	2667	{
2441	@SDL_MODES = dc::SDL_ListModes 5, 0 unless @SDL_MODES;
2442	@SDL_MODES or dc::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
2443
2444	@SDL_MODES = sort { $a->[0] * $a->[1] <=> $b->[0] * $b->[1] } @SDL_MODES;
2445
2446	$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
2447
2448	{
2449	my @fonts = map dc::find_rcfile "fonts/$_", qw(	2668	my @fonts = map DC::find_rcfile "fonts/$_", qw(
2450	DejaVuSans.ttf	2669	DejaVuSans.ttf
2451	DejaVuSansMono.ttf	2670	DejaVuSansMono.ttf
2452	DejaVuSans-Bold.ttf	2671	DejaVuSans-Bold.ttf
2453	DejaVuSansMono-Bold.ttf	2672	DejaVuSansMono-Bold.ttf
2454	DejaVuSans-Oblique.ttf	2673	DejaVuSans-Oblique.ttf
2455	DejaVuSansMono-Oblique.ttf	2674	DejaVuSansMono-Oblique.ttf
2456	DejaVuSans-BoldOblique.ttf	2675	DejaVuSans-BoldOblique.ttf
2457	DejaVuSansMono-BoldOblique.ttf	2676	DejaVuSansMono-BoldOblique.ttf
2458	);	2677	);
2459		2678
2460	dc::add_font $_ for @fonts;	2679	DC::add_font $_ for @fonts;
2461		2680
2462	dc::pango_init;
2463
2464	$FONT_PROP = new_from_file dc::Font $fonts[0];	2681	$FONT_PROP = new_from_file DC::Font $fonts[0];
2465	$FONT_FIXED = new_from_file dc::Font $fonts[1];	2682	$FONT_FIXED = new_from_file DC::Font $fonts[1];
2466		2683
2467	$FONT_PROP->make_default;	2684	$FONT_PROP->make_default;
2468	}	2685
		2686	DC::pango_init;
		2687	}
2469		2688
2470	# compare mono (ft) vs. rgba (cairo)	2689	# compare mono (ft) vs. rgba (cairo)
2471	# ft - 1.8s, cairo 3s, even in alpha-only mode	2690	# ft - 1.8s, cairo 3s, even in alpha-only mode
2472	# for my $rgba (0..1) {	2691	# for my $rgba (0..1) {
2473	# my $t1 = Time::HiRes::time;	2692	# my $t1 = Time::HiRes::time;
2474	# for (1..1000) {	2693	# for (1..1000) {
2475	# my $layout = dc::Layout->new ($rgba);	2694	# my $layout = DC::Layout->new ($rgba);
2476	# $layout->set_text ("hallo" x 100);	2695	# $layout->set_text ("hallo" x 100);
2477	# $layout->render;	2696	# $layout->render;
2478	# }	2697	# }
2479	# my $t2 = Time::HiRes::time;	2698	# my $t2 = Time::HiRes::time;
2480	# warn $t2-$t1;	2699	# warn $t2-$t1;
2481	# }	2700	# }
2482		2701
2483	video_init;	2702	video_init;
2484	audio_init;	2703	audio_init;
2485	}	2704	}
2486		2705
2487	show_tip_of_the_day if $CFG->{show_tips};	2706	show_tip_of_the_day if $CFG->{show_tips};
2488		2707
2489	our $STARTUP_CANCEL = EV::idle sub {	2708	our $STARTUP_CANCEL = EV::idle sub {
2490	undef $::STARTUP_CANCEL;	2709	undef $::STARTUP_CANCEL;
2491	$startup_done->();	2710	$startup_done->();
2492	};	2711	};
2493		2712
		2713	delete $SIG{__DIE__};
2494	EV::loop;	2714	EV::loop;
2495		2715
2496	#video_shutdown;	2716	#video_shutdown;
2497	#audio_shutdown;	2717	#audio_shutdown;
2498	dc::OpenGL::quit;	2718	DC::OpenGL::quit;
2499	dc::SDL_Quit;	2719	DC::SDL_Quit;
2500	dc::DB::Server::stop;	2720	DC::DB::Server::stop;
		2721	}
		2722
		2723	DC::SDL_braino; # see sub above
2501		2724
2502	=head1 NAME	2725	=head1 NAME
2503		2726
2504	deliantra - A Deliantra MORPG game client	2727	deliantra - A Deliantra MORPG game client
2505		2728
…		…
2522	4 show fps	2745	4 show fps
2523	8 suppress tooltips	2746	8 suppress tooltips
2524		2747
2525	=head1 AUTHOR	2748	=head1 AUTHOR
2526		2749
2527	Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>	2750	Marc Lehmann <deliantra@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
2528		2751
2529		2752
2530		2753

Diff Legend

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