ViewVC Help

View File | Revision Log | Show Annotations | Download File

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

Comparing deliantra/Deliantra-Client/bin/pclient (file contents):
Revision 1.119 by root, Mon Apr 17 06:50:26 2006 UTC vs.
Revision 1.242 by root, Tue May 23 23:26:31 2006 UTC

1	#!/opt/bin/perl	1	#!/opt/bin/perl
2		2
3	use strict;	3	use strict;
4	use utf8;	4	use utf8;
5		5
		6	# do things only needed for single-binary version (par)
		7	BEGIN {
		8	if (%PAR::LibCache) {
		9	@INC = grep ref, @INC; # weed out all paths except pars loader refs
		10
		11	while (my ($filename, $zip) = each %PAR::LibCache) {
		12	for ($zip->memberNames) {
		13	next unless /^\/root\/(.*)/;
		14	$zip->extractMember ($_, "$ENV{PAR_TEMP}/$1")
		15	unless -e "$ENV{PAR_TEMP}/$1";
		16	}
		17	}
		18
		19	# TODO: pango-rc file, anybody?
		20
		21	unshift @INC, $ENV{PAR_TEMP};
		22	}
		23	}
		24
		25	# need to do it again because that pile of garbage called PAR nukes it before main
		26	unshift @INC, $ENV{PAR_TEMP}
		27	if %PAR::LibCache;
		28
6	use Time::HiRes 'time';	29	use Time::HiRes 'time';
		30	use Pod::POM;
7	use Event;	31	use Event;
8
9	use SDL;
10	use SDL::App;
11	use SDL::Event;
12	use SDL::Surface;
13	use SDL::OpenGL;
14		32
15	use Crossfire;	33	use Crossfire;
16	use Crossfire::Protocol;	34	use Crossfire::Protocol;
17		35
18	use Compress::LZF;	36	use Compress::LZF;
19		37
20	use CFClient;	38	use CFClient;
21	use CFClient::UI;	39	use CFClient::UI;
		40	use CFClient::MapWidget;
		41
		42	$Event::DIED = sub {
		43	# TODO: display dialog box or so
		44	CFClient::error $_[1];
		45	};
		46
		47	#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#
22		48
23	our $VERSION = '0.1';	49	our $VERSION = '0.1';
24		50
25	my $MAX_FPS = 60;	51	my $MAX_FPS = 60;
26	my $MIN_FPS = 5; # unused as of yet	52	my $MIN_FPS = 5; # unused as of yet
…		…
35	our $NOW;	61	our $NOW;
36		62
37	our $CFG;	63	our $CFG;
38	our $CONN;	64	our $CONN;
39	our $FAST; # fast, low-quality mode, possibly useful for software-rendering	65	our $FAST; # fast, low-quality mode, possibly useful for software-rendering
		66
		67	our $WANT_REFRESH;
		68	our $CAN_REFRESH;
40		69
41	our @SDL_MODES;	70	our @SDL_MODES;
42	our $WIDTH;	71	our $WIDTH;
43	our $HEIGHT;	72	our $HEIGHT;
44	our $FULLSCREEN;	73	our $FULLSCREEN;
45	our $FONTSIZE;	74	our $FONTSIZE;
46		75
		76	our $FONT_PROP;
		77	our $FONT_FIXED;
		78
47	our $MAP;	79	our $MAP;
		80	our $MAPMAP;
48	our $MAPWIDGET;	81	our $MAPWIDGET;
49	our $BUTTONBAR;	82	our $BUTTONBAR;
50	our $LOGVIEW;	83	our $LOGVIEW;
51	our $CONSOLE;	84	our $CONSOLE;
52	our $METASERVER;	85	our $METASERVER;
		86	our $LOGIN_BUTTON;
		87	our $QUIT_DIALOG;
		88
		89	our $FLOORBOX;
		90	our $GAUGES;
		91	our $STATWIDS;
53		92
54	our $SDL_ACTIVE;	93	our $SDL_ACTIVE;
55	our $SDL_EV;
56	our %SDL_CB;	94	our %SDL_CB;
57		95
		96	our $SDL_MIXER;
		97	our @SOUNDS; # event => file mapping
		98	our %AUDIO_CHUNKS; # audio files
		99
58	our $ALT_ENTER_MESSAGE;	100	our $ALT_ENTER_MESSAGE;
59	our $STATUS_LINE;	101	our $STATUSBOX;
60	our $DEBUG_STATUS;	102	our $DEBUG_STATUS;
61		103
		104	our $INVWIN;
		105	our $INV;
		106	our $INVR;
		107	our $INVR_LBL;
		108	our $OPENCONT;
		109
62	sub status {	110	sub status {
63	$STATUS_LINE->set_text ($_[0]);	111	$STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 20, fg => [1, 1, 0, 1]);
64	my ($w, $h) = $STATUS_LINE->size_request;
65	$STATUS_LINE->size_allocate (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $h, $w, $h);
66	}	112	}
67		113
68	sub debug {	114	sub debug {
69	$DEBUG_STATUS->set_text ($_[0]);	115	$DEBUG_STATUS->set_text ($_[0]);
70	my ($w, $h) = $DEBUG_STATUS->size_request;	116	my ($w, $h) = $DEBUG_STATUS->size_request;
71	$DEBUG_STATUS->size_allocate ($WIDTH - $w, 0, $w, $h);	117	$DEBUG_STATUS->move ($WIDTH - $w, 0);
72	}	118	}
73		119
74	sub start_game {	120	sub start_game {
75	status "logging in...";	121	status "logging in...";
76		122
77	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;	123	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
78		124
79	$MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";	125	$MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";
80
81	$MAP = new CFClient::Map $mapsize, $mapsize;	126	$MAP = new CFClient::Map $mapsize, $mapsize;
82		127
83	my ($host, $port) = split /:/, $CFG->{host};	128	my ($host, $port) = split /:/, $CFG->{host};
84		129
85	$CONN = new conn	130	$CONN = eval {
		131	new conn
86	host => $host,	132	host => $host,
87	port => $port || 13327,	133	port => $port || 13327,
88	user => $CFG->{user},	134	user => $CFG->{user},
89	pass => $CFG->{password},	135	pass => $CFG->{password},
90	mapw => $mapsize,	136	mapw => $mapsize,
91	maph => $mapsize,	137	maph => $mapsize,
		138	;
92	;	139	};
93		140
94	status "login successful";	141	if ($CONN) {
95
96	CFClient::lowdelay fileno $CONN->{fh};	142	CFClient::lowdelay fileno $CONN->{fh};
		143
		144	$LOGIN_BUTTON->set_text ("Logout");
		145	status "login successful";
		146
		147	$BUTTONBAR->{children}[1]->emit ("activate")
		148	if $BUTTONBAR->{children}[1]->{state};
		149
		150	} else {
		151	status "unable to connect";
		152	stop_game();
		153	}
97	}	154	}
98		155
99	sub stop_game {	156	sub stop_game {
		157	return unless $CONN;
		158
		159	status "connection closed";
		160	$LOGIN_BUTTON->set_text ("Login");
		161	$CONN->destroy;
		162	$CONN = 0; # false, does not autovivify
		163
		164	$BUTTONBAR->{children}[1]->emit ("activate")
		165	unless $BUTTONBAR->{children}[1]->{state};
		166
		167	undef $MAPCACHE;
100	undef $CONN;	168	undef $MAP;
101	}	169	}
102		170
103	sub client_setup {	171	sub client_setup {
104	my $dialog = new CFClient::UI::FancyFrame	172	my $dialog = new CFClient::UI::FancyFrame
		173	title => "Client Setup",
105	child => (my $vbox = new CFClient::UI::VBox);	174	child => (my $vbox = new CFClient::UI::VBox);
106	$vbox->add (new CFClient::UI::Label align => 0, text => "Client Setup");
107	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);	175	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
108		176
109	$table->add (0, 0, new CFClient::UI::Label align => 1, text => "Video Mode");	177	$table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");
110	$table->add (1, 0, my $hbox = new CFClient::UI::HBox);	178	$table->add (1, 0, my $hbox = new CFClient::UI::HBox);
111		179
112	$hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1]);	180	$hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 1, 1]);
113	$hbox->add (my $mode_label = new CFClient::UI::Label height => $FONTSIZE * 0.8);	181	$hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");
114		182
115	$mode_slider->connect (changed => sub {	183	$mode_slider->connect (changed => sub {
116	my ($self, $value) = @_;	184	my ($self, $value) = @_;
117		185
118	$CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;	186	$CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
119	$mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});	187	$mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});
120	});	188	});
121	$mode_slider->emit (changed => $mode_slider->{range}[0]);	189	$mode_slider->emit (changed => $mode_slider->{range}[0]);
122		190
		191	my $row = 1;
		192
123	$table->add (0, 1, new CFClient::UI::Label align => 1, text => "Fullscreen");	193	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
124	$table->add (1, 1, new CFClient::UI::CheckBox state => $CFG->{fullscreen}, connect_changed => sub {	194	$table->add (1, $row++, new CFClient::UI::CheckBox
		195	state => $CFG->{fullscreen},
		196	tooltip => "Bring the client into fullscreen mode",
		197	connect_changed => sub {
125	my ($self, $value) = @_;	198	my ($self, $value) = @_;
126	$CFG->{fullscreen} = $value;	199	$CFG->{fullscreen} = $value;
		200	}
127	});	201	);
128		202
129	$table->add (0, 2, new CFClient::UI::Label align => 1, text => "Fast & Ugly");	203	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
130	$table->add (1, 2, new CFClient::UI::CheckBox state => $CFG->{fast}, connect_changed => sub {	204	$table->add (1, $row++, new CFClient::UI::CheckBox
		205	state => $CFG->{fast},
		206	tooltip => "Lower the visual quality considerably to speed up rendering.",
		207	connect_changed => sub {
131	my ($self, $value) = @_;	208	my ($self, $value) = @_;
132	$CFG->{fast} = $value;	209	$CFG->{fast} = $value;
		210	}
133	});	211	);
134		212
135	$table->add (0, 3, new CFClient::UI::Label align => 1, text => "Fog of War");	213	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
136	$table->add (1, 3, new CFClient::UI::CheckBox state => $CFG->{fow_enable}, connect_changed => sub {	214	$table->add (1, $row++, new CFClient::UI::Slider
		215	range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
		216	tooltip => "Enlarge or shrink the displayed map",
		217	connect_changed => sub {
137	my ($self, $value) = @_;	218	my ($self, $value) = @_;
		219	$CFG->{map_scale} = 2 ** $value;
		220	}
		221	);
		222
		223	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
		224	$table->add (1, $row++, new CFClient::UI::CheckBox
		225	state => $CFG->{fow_enable},
		226	tooltip => "Fog-of-War marks areas that cannot be seen by the player",
		227	connect_changed => sub {
		228	my ($self, $value) = @_;
138	$CFG->{fow_enable} = $value;	229	$CFG->{fow_enable} = $value;
		230	}
139	});	231	);
140		232
141	$table->add (0, 4, new CFClient::UI::Label align => 1, text => "FoW Intensity");	233	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
142	$table->add (1, 4, new CFClient::UI::Slider range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001], connect_changed => sub {	234	$table->add (1, $row++, new CFClient::UI::Slider
		235	range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001],
		236	tooltip => "The higher the intensity, the lighter the Fog-of-War color",
		237	connect_changed => sub {
143	my ($self, $value) = @_;	238	my ($self, $value) = @_;
144	$CFG->{fow_intensity} = $value;	239	$CFG->{fow_intensity} = $value;
		240	}
145	});	241	);
146		242
147	$table->add (0, 5, new CFClient::UI::Label align => 1, text => "FoW Smooth");	243	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
148	$table->add (1, 5, new CFClient::UI::CheckBox state => $CFG->{fow_smooth}, connect_changed => sub {	244	$table->add (1, $row++, new CFClient::UI::CheckBox
		245	state => $CFG->{fow_smooth},
		246	tooltip => "Smooth the Fog-of-War a bit to make it more realistic",
		247	connect_changed => sub {
149	my ($self, $value) = @_;	248	my ($self, $value) = @_;
150	$CFG->{fow_smooth} = $value;	249	$CFG->{fow_smooth} = $value;
		250	status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2;
		251	}
		252	);
		253
		254	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
		255	$table->add (1, $row++, new CFClient::UI::Slider
		256	range => [$CFG->{gui_fontsize}, 0.5, 2, 0.1, 0.1],
		257	tooltip => "The font size used by most GUI elements",
		258	connect_changed => sub { $CFG->{gui_fontsize} = $_[1] },
		259	);
		260
		261	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Server Log Fontsize");
		262	$table->add (1, $row++, new CFClient::UI::Slider
		263	range => [$CFG->{log_fontsize}, 0.5, 2, 0.1, 0.1],
		264	tooltip => "The font size used by the server log window only",
		265	connect_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]) },
		266	);
		267
		268	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
		269
		270	$table->add (1, $row++, new CFClient::UI::Slider
		271	range => [$CFG->{stat_fontsize}, 0.5, 2, 0.1, 0.1],
		272	tooltip => "The font size used by the statistics window only",
		273	connect_changed => sub {
		274	$CFG->{stat_fontsize} = $_[1];
		275	&set_stats_window_fontsize;
		276	}
		277	);
		278
		279	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
		280	$table->add (1, $row++, new CFClient::UI::Slider
		281	range => [$CFG->{gauge_size}, 0.2, 0.8, 0.02],
		282	tooltip => "Adjust the size of the stats gauges at the bottom right",
		283	connect_changed => sub {
		284	$CFG->{gauge_size} = $_[1];
		285	$GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
		286	}
		287	);
		288
		289	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
		290	$table->add (1, $row++, new CFClient::UI::Slider
		291	range => [$CFG->{gauge_fontsize}, 0.5, 2.0, 0.1, 0.1],
		292	tooltip => "Adjusts the fontsize of the gauges at the bottom right",
		293	connect_changed => sub {
		294	$CFG->{gauge_fontsize} = $_[1];
		295	&set_gauge_window_fontsize;
		296	}
		297	);
		298
		299	$table->add (1, $row++, new CFClient::UI::Button
		300	expand => 1, align => 0, text => "Apply",
		301	tooltip => "Apply the video settings",
		302	connect_activate => sub {
		303	video_shutdown ();
		304	video_init ();
		305	}
		306	);
		307
		308	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");
		309	$table->add (1, $row++, new CFClient::UI::CheckBox
		310	state => $CFG->{audio_enable},
		311	tooltip => "If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.",
		312	connect_changed => sub {
		313	$CFG->{audio_enable} = $_[1];
		314	}
		315	);
		316	# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume");
		317	# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], connect_changed => sub {
		318	# $CFG->{effects_volume} = $_[1];
151	});	319	# });
152
153	$table->add (0, 6, new CFClient::UI::Label align => 1, text => "Log Fontsize");	320	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");
154	$table->add (1, 6, new CFClient::UI::Slider range => [$CFG->{log_fontsize}, 8, 30, 1], connect_changed => sub {	321	$table->add (1, $row++, my $hbox = new CFClient::UI::HBox);
		322	$hbox->add (new CFClient::UI::CheckBox
		323	expand => 1, state => $CFG->{bgm_enable},
		324	tooltip => "Enable background music playing",
		325	connect_changed => sub {
		326	$CFG->{bgm_enable} = $_[1];
		327	}
		328	);
		329	$hbox->add (new CFClient::UI::Slider
		330	expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0.1],
		331	tooltip => "The volume of the background music",
		332	connect_changed => sub {
		333	$CFG->{bgm_volume} = $_[1];
		334	CFClient::MixMusic::volume $_[1] * 128;
		335	}
		336	);
		337
		338	$table->add (1, $row++, new CFClient::UI::Button
		339	expand => 1, align => 0, text => "Apply",
		340	tooltip => "Apply the audio settings",
		341	connect_activate => sub {
		342	audio_shutdown ();
		343	audio_init ();
		344	}
		345	);
		346
		347	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Communication cmd");
		348	$table->add (1, $row++, my $saycmd = new CFClient::UI::Entry
		349	text => $CFG->{say_command},
		350	tooltip => "This is the command that will be used if you write a line in the message window entry. "
		351	."Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
		352	."But you could also set it to 'tell &lt;playername&gt;' to only chat with that user.",
		353	connect_changed => sub {
155	my ($self, $value) = @_;	354	my ($self, $value) = @_;
156	$LOGVIEW->set_fontsize ($CFG->{log_fontsize} = int $value);	355	$CFG->{say_command} = $value;
		356	}
157	});	357	);
158
159	$table->add (1, 7, new CFClient::UI::Button expand => 1, align => 0, text => "Apply", connect_activate => sub {
160	destroy_screen ();
161	init_screen ();
162	});
163		358
164	$dialog	359	$dialog
		360	}
		361
		362	sub set_stats_window_fontsize {
		363	for (values %{$STATWIDS}) {
		364	$_->set_fontsize ($::CFG->{stat_fontsize});
		365	}
		366	}
		367
		368	sub set_gauge_window_fontsize {
		369	for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {
		370	$_->set_fontsize ($::CFG->{gauge_fontsize});
		371	}
		372
		373	# local $GAUGES->{win}{parent};#d#
		374	# use PApp::Util; open D, ">:utf8", "d"; print D PApp::Util::dumpval $GAUGES->{win}; close D;
		375	}
		376
		377	sub make_gauge_window {
		378	my $gh = int $HEIGHT * $CFG->{gauge_size};
		379
		380	my $win = new CFClient::UI::Frame (
		381	req_y => -1,
		382	user_w => $WIDTH,
		383	user_h => $gh,
		384	);
		385
		386	$win->add (my $hbox = new CFClient::UI::HBox
		387	children => [
		388	(new CFClient::UI::HBox expand => 1),
		389	(new CFClient::UI::VBox children => [
		390	(new CFClient::UI::Empty expand => 1),
		391	(new CFClient::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new CFClient::UI::VBox)),
		392	]),
		393	(my $vbox = new CFClient::UI::VBox),
		394	],
		395	);
		396
		397	$vbox->add (new CFClient::UI::HBox
		398	expand => 1,
		399	children => [
		400	(new CFClient::UI::Empty expand => 1),
		401	(my $hb = new CFClient::UI::HBox),
		402	],
		403	);
		404
		405	$hb->add (my $hg = new CFClient::UI::Gauge type => 'hp',
		406	tooltip => "<b>Health points</b>. Measures of how much damage you can take before dying. Hit points are determined from your level and are influenced by the value of your Con. Hp value may range between 1 to beyond 500 and higher values indicate a greater ability to withstand punishment.");
		407	$hb->add (my $mg = new CFClient::UI::Gauge type => 'mana',
		408	tooltip => "<b>Spell points</b>. Measures of how much \"fuel\" you have for casting spells and incantations. Mana is calculated from your level and your Pow. Mana values can range between 1 to beyond 500 (glowing crystals can increase the current spell points beyond your normal maximum). Higher values indicate greater amounts of mana.");
		409	$hb->add (my $gg = new CFClient::UI::Gauge type => 'grace',
		410	tooltip => "<b>Grace points</b> - how favored you are by your god. In game terms, how much divine magic you can cast. Your level, Wis and Pow effect what the value of grace is. Prayong on an altar of your god can increase this value beyond your normal maximum. Grace can take on large positive and negative values. Positive values indicate favor by the gods.");
		411	$hb->add (my $fg = new CFClient::UI::Gauge type => 'food',
		412	tooltip => "<b>Food</b>. Ranges between 0 (starving) and 999 (satiated). At a value of 0 the character begins to die. Some magic can speed up or slow down the character digestion. Healing wounds will speed up digestion too.");
		413
		414	$vbox->add (my $exp = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
		415	tooltip => "<b>Experience points and overall level</b> - experience is increased as a reward for appropriate action (such as killing monsters) and may decrease as a result of a magical attack or dying. Level is directly derived from the experience value. As the level of the character increases, the character becomes able to succeed at more difficult tasks. A character's level starts at a value of 0 and may range up beyond 100.");
		416	$vbox->add (my $rng = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
		417	tooltip => "<b>Ranged attack</b> - how you attack when you press shift-cursor (spell, skill, weapon etc.)");
		418
		419	$GAUGES = {
		420	exp => $exp, win => $win, range => $rng,
		421	food => $fg, mana => $mg, hp => $hg, grace => $gg
		422	};
		423
		424	&set_gauge_window_fontsize;
		425
		426	$win
		427	}
		428
		429	sub make_stats_window {
		430	my $tgw = new CFClient::UI::FancyFrame title => "Stats";
		431
		432	$tgw->add (new CFClient::UI::Window child => my $vb = new CFClient::UI::VBox);
		433	$vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,
		434	can_hover => 1, can_events => 1,
		435	tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");
		436	$vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,
		437	can_hover => 1, can_events => 1,
		438	tooltip => "The map you are currently on (if supported by the server).");
		439
		440	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
		441	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);
		442
		443	my $color2 = [1, 1, 0];
		444
		445	for (
		446	[0, 0, st_str => "Str", 30, "<b>Physical Strength</b>, determines damage dealt with weapons, how much you can carry, and how often you can attack"],
		447	[0, 1, st_dex => "Dex", 30, "<b>Dexterity</b>, your physical agility. Determines chance of being hit and affects armor class and speed"],
		448	[0, 2, st_con => "Con", 30, "<b>Constitution</b>, physical health and toughness. Determines how many healthpoints you can have"],
		449	[0, 3, st_int => "Int", 30, "<b>Intelligence</b>, your ability to learn and use skills and incantations (both prayers and magic) and determines how much spell points you can have"],
		450	[0, 4, st_wis => "Wis", 30, "<b>Wisdom</b>, the ability to learn and use divine magic (prayers). Determines how many grace points you can have"],
		451	[0, 5, st_pow => "Pow", 30, "<b>Power</b>, your magical potential. Influences the strength of spell effects, and also how much your spell and grace points increase when leveling up"],
		452	[0, 6, st_cha => "Cha", 30, "<b>Charisma</b>, how well you are received by NPCs. Affects buying and selling prices in shops."],
		453
		454	[2, 0, st_wc => "Wc", -120, "<b>Weapon Class</b>, effectiveness of melee/missile attacks. Lower is more potent. Current weapon, level and Str are some things which effect the value of Wc. The value of Wc may range between 25 and -72."],
		455	[2, 1, st_ac => "Ac", -120, "<b>Armour Class</b>, how protected you are from being hit by any attack. Lower values are better. Ac is based on your race and is modified by the Dex and current armour worn. For characters that cannot wear armour, Ac improves as their level increases."],
		456	[2, 2, st_dam => "Dam", 120, "<b>Damage</b>, how much damage your melee/missile attack inflicts. Higher values indicate a greater amount of damage will be inflicted with each attack."],
		457	[2, 3, st_arm => "Arm", 120, "<b>Armour</b>, how much damage (from physical attacks) will be subtracted from successful hits made upon you. This value ranges between 0 to 99%. Current armour worn primarily determines Arm value."],
		458	[2, 4, st_spd => "Spd", 10.54, "<b>Speed</b>, how fast you can move. The value of speed may range between nearly 0 (\"very slow\") to higher than 5 (\"lightning fast\"). Base speed is determined from the Dex and modified downward proportionally by the amount of weight carried which exceeds the Max Carry limit. The armour worn also sets the upper limit on speed."],
		459	[2, 5, st_wspd => "WSp", 10.54, "<b>Weapon Speed</b>, how many attacks you may make per unit of time (0.120s). Higher values indicate faster attack speed. Current weapon and Dex effect the value of weapon speed."],
		460	) {
		461	my ($col, $row, $id, $label, $template, $tooltip) = @$_;
		462
		463	$tbl->add ($col , $row, $STATWIDS->{$id} = new CFClient::UI::Label
		464	font => $FONT_FIXED, can_hover => 1, can_events => 1, valign => 0, align => +1, template => $template, tooltip => $tooltip);
		465	$tbl->add ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFClient::UI::Label
		466	font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $color2, valign => 0, align => -1, text => $label, tooltip => $tooltip);
		467	}
		468
		469	$hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);
		470
		471	my $row = 0;
		472	my $col = 0;
		473
		474	my %resist_names = (
		475	slow => "<b>Slow</b> (slows you down when you are hit by the spell. Monsters will have an opportunity to come near you faster and hit you more often.)",
		476	holyw => "<b>Holy Word</b> (resistance you against getting the fear when someone whose god doesn't like you spells the holy word on you.)",
		477	conf => "<b>Confusion</b> (If you are hit by confusion you will move into random directions, and likely into monsters.)",
		478	fire => "<b>Fire</b> (just your resistance to fire spells like burning hands, dragonbreath, meteor swarm fire, ...)",
		479	depl => "<b>Depletion</b> (some monsters and other effects can cause stats depletion)",
		480	magic => "<b>Magic</b> (resistance to magic spells like magic missile or similar)",
		481	drain => "<b>Draining</b> (some monsters (e.g. vampires) and other effects can steal experience)",
		482	acid => "<b>Acid</b> (resistance to acid, acid hurts pretty much and also corrodes your weapons)",
		483	pois => "<b>Poison</b> (resistance to getting poisoned)",
		484	para => "<b>Paralysation</b> (this resistance affects the chance you get paralysed)",
		485	deat => "<b>Death</b> (resistance against death spells)",
		486	phys => "<b>Physical</b> (this is the resistance against physical attacks, like when a monster hit you in melee combat)",
		487	blind => "<b>Blind</b> (blind resistance affects the chance of a successful blinding attack)",
		488	fear => "<b>Fear</b> (this attack will drive you away from monsters who cast this and hit you successfully, being resistant to this helps a lot when fighting those monsters)",
		489	tund => "<b>Turn undead</b> (affects your resistancy to various forms of 'turn undead' spells. Only relevant when you are, in fact, undead...",
		490	elec => "<b>Electricity</b> (resistance against electricity, spells like large lightning, small lightning, ...)",
		491	cold => "<b>Cold</b> (this is your resistance against cold spells like icestorm, snowstorm, ...)",
		492	ghit => "<b>Ghost hit</b> (special attack used by ghosts and ghost-like beings)",
		493	);
		494	for (qw/slow holyw conf fire depl magic
		495	drain acid pois para deat phys
		496	blind fear tund elec cold ghit/)
		497	{
		498	$tbl2->add ($col, $row,
		499	$STATWIDS->{"res_$_"} =
		500	new CFClient::UI::Label
		501	font => $FONT_FIXED,
		502	template => "-100%",
		503	align => +1,
		504	valign => 0,
		505	can_events => 1,
		506	can_hover => 1,
		507	tooltip => $resist_names{$_},
		508	);
		509	$tbl2->add ($col + 1, $row, new CFClient::UI::Image
		510	font => $FONT_FIXED,
		511	can_hover => 1,
		512	can_events => 1,
		513	image => "ui/resist/resist_$_.png",
		514	tooltip => $resist_names{$_},
		515	);
		516
		517	$row++;
		518	if ($row % 6 == 0) {
		519	$col += 2;
		520	$row = 0;
		521	}
		522	}
		523
		524	&set_stats_window_fontsize;
		525	update_stats_window ({});
		526
		527	$tgw
		528	}
		529
		530	sub formsep {
		531	reverse join ",", grep length, split /(...)/, reverse $_[0] * 1
		532	}
		533
		534	sub update_stats_window {
		535	my ($stats) = @_;
		536
		537	# i love text protocols!!!
		538	my $hp = $stats->{Crossfire::Protocol::CS_STAT_HP} * 1;
		539	my $hp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXHP} * 1;
		540	my $sp = $stats->{Crossfire::Protocol::CS_STAT_SP} * 1;
		541	my $sp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXSP} * 1;
		542	my $fo = $stats->{Crossfire::Protocol::CS_STAT_FOOD} * 1;
		543	my $fo_m = 999;
		544	my $gr = $stats->{Crossfire::Protocol::CS_STAT_GRACE} * 1;
		545	my $gr_m = $stats->{Crossfire::Protocol::CS_STAT_MAXGRACE} * 1;
		546
		547	$GAUGES->{hp} ->set_value ($hp, $hp_m);
		548	$GAUGES->{mana} ->set_value ($sp, $sp_m);
		549	$GAUGES->{food} ->set_value ($fo, $fo_m);
		550	$GAUGES->{grace} ->set_value ($gr, $gr_m);
		551	$GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::CS_STAT_EXP64})
		552	. " (lvl " . ($stats->{Crossfire::Protocol::CS_STAT_LEVEL} * 1) . ")");
		553	my $rng = $stats->{Crossfire::Protocol::CS_STAT_RANGE};
		554	$rng =~ s/^Range: //; # thank you so much dear server
		555	$GAUGES->{range} ->set_text ("Rng: " . $rng);
		556	my $title = $stats->{Crossfire::Protocol::CS_STAT_TITLE};
		557	$title =~ s/^Player: //;
		558	$STATWIDS->{title} ->set_text ("Title: " . $title);
		559
		560	$STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});
		561	$STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});
		562	$STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9});
		563	$STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6});
		564	$STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7});
		565	$STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22});
		566	$STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});
		567	$STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13});
		568	$STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14});
		569	$STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});
		570	$STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});
		571	$STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_SPEED});
		572	$STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_WEAP_SP});
		573
		574	my %tbl = (
		575	phys => 100,
		576	magic => 101,
		577	fire => 102,
		578	elec => 103,
		579	cold => 104,
		580	conf => 105,
		581	acid => 106,
		582	drain => 107,
		583	ghit => 108,
		584	pois => 109,
		585	slow => 110,
		586	para => 111,
		587	tund => 112,
		588	fear => 113,
		589	depl => 113,
		590	deat => 115,
		591	holyw => 116,
		592	blind => 117
		593	);
		594
		595	for (keys %tbl) {
		596	$STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}});
		597	}
		598
165	}	599	}
166		600
167	sub metaserver_dialog {	601	sub metaserver_dialog {
168	my $dialog = new CFClient::UI::FancyFrame	602	my $dialog = new CFClient::UI::FancyFrame
		603	title => "Server List",
169	child => (my $vbox = new CFClient::UI::VBox);	604	child => (my $vbox = new CFClient::UI::VBox);
170		605
171	$vbox->add ($dialog->{table} = new CFClient::UI::Table);	606	$vbox->add ($dialog->{table} = new CFClient::UI::Table);
172		607
173	$dialog	608	$dialog
174	}	609	}
		610
		611	my $METASERVER_ATIME;
175		612
176	sub update_metaserver {	613	sub update_metaserver {
177	my ($HOST) = @_;	614	my ($HOST) = @_;
178		615
179	status "fetching metaserver list...";	616	return if $METASERVER_ATIME > time;
		617	$METASERVER_ATIME = time + 60;
		618
		619	my $table = $METASERVER->{table};
		620	$table->clear;
		621	$table->add (0, 0, my $label = new CFClient::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
180		622
181	my $buf;	623	my $buf;
182		624
183	my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;	625	my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;
		626
		627	unless ($fh) {
		628	$label->set_text ("unable to contact metaserver: $!");
		629	return;
		630	}
184		631
185	Event->io (fd => $fh, poll => 'r', cb => sub {	632	Event->io (fd => $fh, poll => 'r', cb => sub {
186	my $res = sysread $fh, $buf, 8192, length $buf;	633	my $res = sysread $fh, $buf, 8192, length $buf;
187		634
188	if (!defined $res) {	635	if (!defined $res) {
189	$_[0]->w->cancel;	636	$_[0]->w->cancel;
190	status "metaserver: $!";	637	$label->set_text ("error while retrieving server list: $!");
191	} elsif ($res == 0) {	638	} elsif ($res == 0) {
192	$_[0]->w->cancel;	639	$_[0]->w->cancel;
193	status "server list retrieved";	640	status "server list retrieved";
194		641
195	my $table = $METASERVER->{table};	642	utf8::decode $buf if utf8::valid $buf;
196		643
197	$table->clear;	644	$table->clear;
198		645
199	my @col = qw(Use #Users Host Uptime Version Description);	646	my @col = qw(Use #Users Host Uptime Version Description);
200	$table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])	647	$table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])
…		…
224	$m = [$users, $host, $uptime, $version, $desc];	671	$m = [$users, $host, $uptime, $version, $desc];
225		672
226	$y++;	673	$y++;
227		674
228	$table->add (0, $y, new CFClient::UI::VBox children => [	675	$table->add (0, $y, new CFClient::UI::VBox children => [
229	(new CFClient::UI::Button text => " ", connect_activate => sub {	676	(new CFClient::UI::Button text => "Use", connect_activate => sub {
230	$HOST->set_text ($CFG->{host} = $host);	677	$HOST->set_text ($CFG->{host} = $host);
231	}),	678	}),
232	(new CFClient::UI::Empty expand => 1),	679	(new CFClient::UI::Empty expand => 1),
233	]);	680	]);
234		681
235	$table->add ($_ + 1, $y, new CFClient::UI::Label align => $align[$_], text => $m->[$_], fontsize => $FONTSIZE * 0.8)	682	$table->add ($_ + 1, $y, new CFClient::UI::Label
		683	ellipsise => 0, align => $align[$_], text => $m->[$_], fontsize => 0.8)
236	for 0 .. $#$m;	684	for 0 .. $#$m;
237	}	685	}
238	}	686	}
239	});	687	});
240	}	688	}
241		689
242	sub server_setup {	690	sub server_setup {
243	my $dialog = new CFClient::UI::FancyFrame	691	my $dialog = new CFClient::UI::FancyFrame
		692	title => "Server Setup",
244	child => (my $vbox = new CFClient::UI::VBox);	693	child => (my $vbox = new CFClient::UI::VBox);
245		694
246	$vbox->add (new CFClient::UI::Label align => 0, text => "Server Setup");
247	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);	695	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
248	$table->add (0, 2, new CFClient::UI::Label align => 1, text => "Host:Port");	696	$table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
249		697
250	{	698	{
251	$table->add (1, 2, my $vbox = new CFClient::UI::VBox);	699	$table->add (1, 2, my $vbox = new CFClient::UI::VBox);
252		700
253	$vbox->add (my $HOST = new CFClient::UI::Entry text => $CFG->{host}, connect_changed => sub {	701	$vbox->add (
		702	my $HOST = new CFClient::UI::Entry
		703	expand => 1,
		704	text => $CFG->{host},
		705	tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
		706	connect_changed => sub {
		707	my ($self, $value) = @_;
		708	$CFG->{host} = $value;
		709	}
		710	);
		711
		712	$METASERVER = metaserver_dialog;
		713
		714	$vbox->add (new CFClient::UI::Flopper
		715	expand => 1,
		716	text => "Server List",
		717	other => $METASERVER,
		718	tooltip => "Show a list of available crossfire servers",
		719	connect_open => sub {
		720	update_metaserver $HOST;
		721	}
		722	);
		723	}
		724
		725	$table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
		726	$table->add (1, 4, new CFClient::UI::Entry
		727	text => $CFG->{user},
		728	tooltip => "The name of your character on the server",
		729	connect_changed => sub {
254	my ($self, $value) = @_;	730	my ($self, $value) = @_;
255	$CFG->{host} = $value;	731	$CFG->{user} = $value;
256	});	732	}
		733	);
257		734
258	$METASERVER = metaserver_dialog;
259
260	$vbox->add (new CFClient::UI::Flopper text => "Metaserver", other => $METASERVER, connect_open => sub {
261	update_metaserver $HOST;
262	});
263	}
264
265	$table->add (0, 4, new CFClient::UI::Label align => 1, text => "Username");	735	$table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
266	$table->add (1, 4, new CFClient::UI::Entry text => $CFG->{user}, connect_changed => sub {	736	$table->add (1, 5, new CFClient::UI::Entry
		737	text => $CFG->{password},
		738	hidden => 1,
		739	tooltip => "The password for your character",
		740	connect_changed => sub {
267	my ($self, $value) = @_;	741	my ($self, $value) = @_;
268	$CFG->{user} = $value;
269	});
270
271	$table->add (0, 5, new CFClient::UI::Label align => 1, text => "Password");
272	$table->add (1, 5, new CFClient::UI::Entry text => $CFG->{password}, hidden => 1, connect_changed => sub {
273	my ($self, $value) = @_;
274	$CFG->{password} = $value;	742	$CFG->{password} = $value;
		743	}
275	});	744	);
276		745
277	$table->add (0, 6, new CFClient::UI::Label align => 1, text => "Def. say cmd");
278	$table->add (1, 6, my $saycmd = new CFClient::UI::Entry text => $CFG->{say_command}, connect_changed => sub {
279	my ($self, $value) = @_;
280	$CFG->{say_command} = $value;
281	});
282
283	$table->add (0, 7, new CFClient::UI::Label align => 1, text => "Map Size");	746	$table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
284	$table->add (1, 7, new CFClient::UI::Slider	747	$table->add (1, 7, new CFClient::UI::Slider
285	req_w => 100,	748	req_w => 100,
286	range => [$CFG->{mapsize}, 10, 100 + 1, 1],	749	range => [$CFG->{mapsize}, 10, 100 + 1, 1, 1],
		750	tooltip => "This is the size of the portion of the map update the server sends you. "
		751	."If you set this to a high value you will be able to see further for example.",
287	connect_changed => sub {	752	connect_changed => sub {
288	my ($self, $value) = @_;	753	my ($self, $value) = @_;
289		754
290	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;	755	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;
291	},	756	},
292	);	757	);
293		758
294	$table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Login", connect_activate => sub {	759	$table->add (0, 8, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");
295	start_game;	760	$table->add (1, 8, new CFClient::UI::Entry
		761	text => $CFG->{output_count},
		762	tooltip => "Should be set to 1 unless you know what you are doing",
		763	connect_changed => sub { $CFG->{output_count} = $_[1] },
296	});	764	);
		765
		766	$table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");
		767	$table->add (1, 9, new CFClient::UI::Entry
		768	text => $CFG->{output_sync},
		769	tooltip => "Should be set to 1 unless you know what you are doing",
		770	connect_changed => sub { $CFG->{output_sync} = $_[1] },
		771	);
		772
		773	$table->add (1, 10, $LOGIN_BUTTON = new CFClient::UI::Button
		774	expand => 1,
		775	align => 0,
		776	text => "Login",
		777	connect_activate => sub {
		778	$CONN ? stop_game
		779	: start_game;
		780	},
		781	);
297		782
298	$dialog	783	$dialog
299	}	784	}
300		785
301	sub message_window {	786	sub message_window {
302	my $window = new CFClient::UI::FancyFrame	787	my $window = new CFClient::UI::FancyFrame
		788	title => "Messages",
303	border_bg => [1, 1, 1, 0.5],	789	border_bg => [1, 1, 1, 1],
304	bg => [0.3, 0.3, 0.3, 0.8],	790	bg => [0, 0, 0, 0.75],
305	user_w => $::WIDTH/4,	791	user_w => int $::WIDTH / 3,
306	user_h => $::HEIGHT,	792	user_h => int $::HEIGHT / 5,
307	child => (my $vbox = new CFClient::UI::VBox);	793	child => (my $vbox = new CFClient::UI::VBox);
308		794
309	$vbox->add ($LOGVIEW = new CFClient::UI::TextView	795	$vbox->add ($LOGVIEW);
310	expand => 1,
311	fontsize => $::CFG->{log_fontsize},
312	);
313		796
314	$vbox->add (my $input = new CFClient::UI::LineEntry	797	$vbox->add (my $input = new CFClient::UI::Entry
		798	tooltip => "<b>Chat Box</b>. If you enter a text and press return/enter here, the current <i>communication command</i> "
		799	. "from the client setup will be prepended (e.g. <b>shout</b>, <b>chat</b>...). "
		800	. "If you prepend a slash (/), you will submit a command instead (similar to IRC). "
		801	. "A better way to submit commands (and the occasional chat command) is often the map command completer.",
315	connect_focus_in => sub {	802	connect_focus_in => sub {
316	my ($input, $prev_focus) = @_;	803	my ($input, $prev_focus) = @_;
317		804
318	delete $input->{refocus_map};	805	delete $input->{refocus_map};
319		806
…		…
325	connect_activate => sub {	812	connect_activate => sub {
326	my ($input, $text) = @_;	813	my ($input, $text) = @_;
327	$input->set_text ('');	814	$input->set_text ('');
328		815
329	if ($text =~ /^\/(.*)/) {	816	if ($text =~ /^\/(.*)/) {
330	$::CONN->user_send ("command $1");	817	$::CONN->user_send ($1);
331	} else {	818	} else {
332	my $say_cmd = $::CFG->{say_command} || 'say';	819	my $say_cmd = $::CFG->{say_command} || 'say';
333	$::CONN->user_send ("command $say_cmd $text");	820	$::CONN->user_send ("$say_cmd $text");
334	}	821	}
335	if ($input->{refocus_map}) {	822	if ($input->{refocus_map}) {
336	delete $input->{refocus_map};	823	delete $input->{refocus_map};
337	$MAPWIDGET->focus_in	824	$MAPWIDGET->focus_in
338	}	825	}
…		…
348	};	835	};
349		836
350	$window	837	$window
351	}	838	}
352		839
		840	sub open_quit_dialog {
		841	unless ($QUIT_DIALOG) {
		842
		843	$QUIT_DIALOG = new CFClient::UI::FancyFrame title => "Really Quit?";
		844
		845	$QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);
		846
		847	$vb->add (new CFClient::UI::Label
		848	text => "You should find a savebed and apply it first!",
		849	max_w => $WIDTH * 0.25
		850	);
		851	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
		852	$hb->add (new CFClient::UI::Button
		853	text => "Ok",
		854	connect_activate => sub { $QUIT_DIALOG->hide },
		855	expand => 1
		856	);
		857	$hb->add (new CFClient::UI::Button
		858	text => "Quit anyway",
		859	connect_activate => sub { exit 1 },
		860	expand => 1
		861	);
		862	$hb->add (new CFClient::UI::Label "You should find a savebed and apply it first!");
		863
		864	$QUIT_DIALOG->show_centered;
		865	} else {
		866	$QUIT_DIALOG->show_centered;
		867	}
		868	}
		869
		870	sub make_inventory_window {
		871	my $invwin = new CFClient::UI::FancyFrame
		872	user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Inventory";
		873
		874	$invwin->add (my $hb = new CFClient::UI::HBox expand => 1);
		875
		876	$hb->add (my $vb1 = new CFClient::UI::VBox expand => 1);
		877	$vb1->add (my $lbl = new CFClient::UI::Label);
		878	$lbl->set_text ("Player");
		879	$vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
		880
		881	$hb->add (my $vb2 = new CFClient::UI::VBox expand => 1);
		882	$vb2->add ($INVR_LBL = new CFClient::UI::Label);
		883	$INVR_LBL->set_text ("Floor");
		884	$vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);
		885
		886	$invwin
		887	}
		888
		889	sub make_help_window {
		890	my $win = new CFClient::UI::FancyFrame
		891	user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Documentation";
		892
		893	$win->add (my $vbox = new CFClient::UI::VBox);
		894
		895	$vbox->add (my $buttons = new CFClient::UI::HBox);
		896	$vbox->add (my $viewer = new CFClient::UI::TextView expand => 1, fontsize => 0.8);
		897
		898	for (
		899	[intro => "Introduction"],
		900	[command_help => "Commands"],
		901	[skill_help => "Skills"],
		902	) {
		903	my ($pod, $label) = @$_;
		904
		905	$buttons->add (new CFClient::UI::Button
		906	text => $label,
		907	connect_activate => sub {
		908	my $parser = new Pod::POM;
		909	my $pom = $parser->parse_file (CFClient::find_rcfile "pod/$pod.pod");
		910
		911	$viewer->clear;
		912
		913	$viewer->add_paragraph ([1, 1, 1, 1], $_->[1], $_->[0])
		914	for @{ CFClient::pod_to_pango_list $pom };
		915	},
		916	);
		917	}
		918
		919	$viewer->add_paragraph ([1, 1, 0, 1], "<big>Use one of the buttons above to display a document.</big>");
		920
		921	$win
		922	}
		923
353	sub sdl_init {	924	sub sdl_init {
354	#SDL::Init SDL_INIT_AUDIO | SDL_INIT_VIDEO | SDL_INIT_NOPARACHUTE	925	CFClient::SDL_Init
355	SDL::Init SDL_INIT_AUDIO | SDL_INIT_VIDEO
356	and die "SDL::Init failed!\n";	926	and die "SDL::Init failed!\n";
357	}	927	}
358		928
359	sub init_screen {	929	sub video_init {
360	sdl_init;	930	sdl_init;
		931
		932	$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
361		933
362	($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };	934	($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
363	$FULLSCREEN = $CFG->{fullscreen};	935	$FULLSCREEN = $CFG->{fullscreen};
364	$FAST = $CFG->{fast};	936	$FAST = $CFG->{fast};
365		937
366	SDL::GLSetAttribute SDL_GL_RED_SIZE, 5;	938	CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
367	SDL::GLSetAttribute SDL_GL_GREEN_SIZE, 5;	939	or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";
368	SDL::GLSetAttribute SDL_GL_BLUE_SIZE, 5;
369	SDL::GLSetAttribute SDL_GL_ALPHA_SIZE, 1;
370
371	SDL::GLSetAttribute SDL_GL_ACCUM_RED_SIZE, 0;
372	SDL::GLSetAttribute SDL_GL_ACCUM_GREEN_SIZE, 0;
373	SDL::GLSetAttribute SDL_GL_ACCUM_BLUE_SIZE, 0;
374	SDL::GLSetAttribute SDL_GL_ACCUM_ALPHA_SIZE, 0;
375
376	SDL::GLSetAttribute SDL_GL_DOUBLEBUFFER, 1;
377	SDL::GLSetAttribute SDL_GL_BUFFER_SIZE, 15;
378	SDL::GLSetAttribute SDL_GL_DEPTH_SIZE, 0;
379
380	SDL::SetVideoMode $WIDTH, $HEIGHT, 0,
381	SDL_HWSURFACE | SDL_ANYFORMAT | SDL_OPENGL | SDL_DOUBLEBUF
382	| ($FULLSCREEN ? SDL_FULLSCREEN : 0)
383	or die "SDL::SetVideoMode failed!\n";
384
385	SDL::WMSetCaption "Crossfire+ Client", "Crossfire+";
386
387	$SDL_EV = new SDL::Event;
388	$SDL_EV->set_unicode (1);
389		940
390	$SDL_ACTIVE = 1;	941	$SDL_ACTIVE = 1;
391
392	$LAST_REFRESH = time - 0.01;	942	$LAST_REFRESH = time - 0.01;
393		943
394	CFClient::gl_init;	944	CFClient::gl_init;
395		945
396	$FONTSIZE = int $HEIGHT / 40;	946	$FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
		947
		948	$CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
397		949
398	#############################################################################	950	#############################################################################
399		951
		952	unless ($DEBUG_STATUS) {
		953	# create the widgets
		954
400	$DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100;	955	$DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100, req_x => -1;
401	$CFClient::UI::ROOT->add ($DEBUG_STATUS);	956	$DEBUG_STATUS->show;
402		957
403	$STATUS_LINE = new CFClient::UI::Label	958	$STATUSBOX = new CFClient::UI::Statusbox;
404	padding => 0,	959	$STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", pri => -100, color => [1, 1, 1, 0.8]);
405	y => $HEIGHT * 44 / 45 - $FONTSIZE;
406	$CFClient::UI::ROOT->add ($STATUS_LINE);
407		960
408	$ALT_ENTER_MESSAGE = new CFClient::UI::Label	961	(new CFClient::UI::Frame
409	padding => 0,	962	bg => [0, 0, 0, 0.4],
410	y => $HEIGHT * 44 / 45,	963	req_y => -1,
411	height => $HEIGHT / 45,	964	child => $STATUSBOX,
412	text => "Use <b>Alt-Enter</b> to toggle fullscreen mode";	965	)->show;
413	$CFClient::UI::ROOT->add ($ALT_ENTER_MESSAGE);
414		966
415	$CFClient::UI::ROOT->add ($MAPWIDGET = new CFClient::UI::MapWidget);	967	CFClient::UI::FancyFrame->new (
416	$MAPWIDGET->focus_in;	968	border_bg => [1, 1, 1, 192/255],
		969	bg => [1, 1, 1, 0],
		970	child => ($MAPMAP = new CFClient::MapWidget::MapMap
		971	tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
		972	),
		973	)->show;
		974
		975	$MAPWIDGET = new CFClient::MapWidget;
417	$MAPWIDGET->connect (activate_console => sub {	976	$MAPWIDGET->connect (activate_console => sub {
418	my ($mapwidget, $preset) = @_;	977	my ($mapwidget, $preset) = @_;
419		978
420	if ($CONSOLE) {	979	if ($CONSOLE) {
421	$CONSOLE->{input}->{auto_activated} = 1;	980	$CONSOLE->{input}->{auto_activated} = 1;
422	$CONSOLE->{input}->focus_in;	981	$CONSOLE->{input}->focus_in;
423		982
424	if ($preset && $CONSOLE->{input}->get_text eq '') {	983	if ($preset && $CONSOLE->{input}->get_text eq '') {
425	$CONSOLE->{input}->set_text ($preset);	984	$CONSOLE->{input}->set_text ($preset);
		985	}
426	}	986	}
427	}	987	});
428	});	988	$MAPWIDGET->show;
		989	$MAPWIDGET->focus_in;
429		990
430	$CFClient::UI::ROOT->add ($BUTTONBAR = new CFClient::UI::HBox);	991	$LOGVIEW = new CFClient::UI::TextView
		992	expand => 1,
		993	font => $FONT_FIXED,
		994	fontsize => $::CFG->{log_fontsize},
		995	can_hover => 1,
		996	can_events => 1,
		997	tooltip => "<b>Server Log</b>. This text viewer contains all the messages sent by the server.",
		998	;
431		999
		1000	$BUTTONBAR = new CFClient::UI::HBox;
		1001
432	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup);	1002	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup,
		1003	tooltip => "Toggles a dialog where you can configure various aspects of the client, such as graphics mode, performance, and audio options.");
433	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup);	1004	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup,
		1005	tooltip => "Toggles a dialog where you can configure the server to play on, your username, password and other server-related options.");
434	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);	1006	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window,
		1007	tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
435		1008
436	$BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {	1009	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
		1010
		1011	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window,
		1012	tooltip => "Toggles the statistics window, where all your Stats and Resistances are beign displaye at all times.");
		1013	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => make_inventory_window,
		1014	tooltip => "Toggles the inventory window, where you can manage your loot (or treaures :).");
		1015
		1016	$BUTTONBAR->add (new CFClient::UI::Button
		1017	text => "Save Config",
		1018	tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
		1019	connect_activate => sub {
437	CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";	1020	CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
438	status "Configuration Saved";	1021	status "Configuration Saved";
439	});	1022	},
		1023	);
440		1024
		1025	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Help!", other => make_help_window,
		1026	tooltip => "View Documentation");
		1027
		1028	$BUTTONBAR->add (new CFClient::UI::Button
		1029	text => "Quit",
		1030	tooltip => "Terminates the program",
		1031	connect_activate => sub {
		1032	if ($CONN) {
		1033	open_quit_dialog;
		1034	} else {
		1035	exit;
		1036	}
		1037	},
		1038	);
		1039
		1040	$BUTTONBAR->show;
		1041
		1042	$STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
		1043
		1044	# delay till geometry is constant
		1045	$CFClient::UI::ROOT->on_post_alloc (startup => sub {
441	$BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup	1046	$BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
		1047	my $widget = $GAUGES->{win};
		1048	$widget->move (0, $HEIGHT - $widget->{h});#d# to in toplevel
		1049	});
		1050	force_refresh ();
		1051	}
442	}	1052	}
443		1053
444	sub destroy_screen {	1054	sub video_shutdown {
445	$CFClient::UI::ROOT->{children} = [];
446	undef $SDL_ACTIVE;	1055	undef $SDL_ACTIVE;
		1056	}
		1057
		1058	my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
		1059	my $bgmusic;#TODO#hack#d#
		1060
		1061	sub audio_channel_finished {
		1062	my ($channel) = @_;
		1063
		1064	#warn "channel $channel finished\n";#d#
		1065	}
		1066
		1067	sub audio_music_finished {
		1068	return unless $CFG->{bgm_enable};
		1069
		1070	# TODO: hack, do play loop and mood music
		1071	$bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/$bgmusic[0]";
		1072	$bgmusic->play (0);
		1073
		1074	push @bgmusic, shift @bgmusic;
		1075	}
		1076
		1077	sub audio_init {
		1078	if ($CFG->{audio_enable}) {
		1079	if (open my $fh, "<", CFClient::find_rcfile "sounds/config") {
		1080	$SDL_MIXER = !CFClient::Mix_OpenAudio;
		1081
		1082	unless ($SDL_MIXER) {
		1083	status "Unable to open sound device: there will be no sound";
		1084	return;
		1085	}
		1086
		1087	CFClient::Mix_AllocateChannels 8;
		1088	CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
		1089
		1090	audio_music_finished;
		1091
		1092	while (<$fh>) {
		1093	next if /^\s*#/;
		1094	next if /^\s*$/;
		1095
		1096	my ($file, $volume, $event) = split /\s+/, $_, 3;
		1097
		1098	push @SOUNDS, "$volume,$file";
		1099
		1100	$AUDIO_CHUNKS{"$volume,$file"} ||= do {
		1101	my $chunk = new_from_file CFClient::MixChunk CFClient::find_rcfile "sounds/$file";
		1102	$chunk->volume ($volume * 128 / 100);
		1103	$chunk
		1104	};
		1105	}
		1106	} else {
		1107	status "unable to open sound config: $!";
		1108	}
		1109	}
		1110	}
		1111
		1112	sub audio_shutdown {
		1113	CFClient::Mix_CloseAudio if $SDL_MIXER;
447	undef $SDL_EV;	1114	undef $SDL_MIXER;
448	SDL::Quit;	1115	@SOUNDS = ();
		1116	%AUDIO_CHUNKS = ();
449	}	1117	}
450		1118
451	my %animate_object;	1119	my %animate_object;
452	my $animate_timer;	1120	my $animate_timer;
453		1121
454	my $want_refresh;
455	my $can_refresh;
456
457	my $fps = 9;	1122	my $fps = 9;
458		1123
		1124	my %demo;#d#
		1125
459	sub force_refresh {	1126	sub force_refresh {
460	$fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05;	1127	$fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
461	debug sprintf "%3.2f", $fps;	1128	debug sprintf "%3.2f", $fps;
462		1129
463	$want_refresh = 0;
464	$can_refresh = 0;
465
466	$CFClient::UI::ROOT->draw;	1130	$CFClient::UI::ROOT->draw;
467		1131
468	SDL::GLSwapBuffers;	1132	$WANT_REFRESH = 0;
469		1133	$CAN_REFRESH = 0;
470	$LAST_REFRESH = $NOW;	1134	$LAST_REFRESH = $NOW;
		1135
		1136	0 && do {
		1137	# some weird model-drawing code, just a joke right now
		1138	use CFClient::OpenGL;
		1139
		1140	$demo{t}{eye_auv} ||= new_from_file CFClient::Texture "eye2.png" or die;
		1141	$demo{t}{body_auv} ||= new_from_file CFClient::Texture "body_auv3.png" or die;
		1142	$demo{r} ||= do {
		1143	my $mod = Compress::LZF::sthaw do { local $/; open my $fh, "<:raw:perlio", "dread.lz3"; <$fh> };
		1144	$mod->{v} = pack "f*", @{$mod->{v}};
		1145	$_ = [scalar @$_, pack "S!*", @$_]
		1146	for values %{$mod->{g}};
		1147	$mod
		1148	};
		1149
		1150	my $r = $demo{r} or die;
		1151
		1152	glDepthMask 1;
		1153	glClear GL_DEPTH_BUFFER_BIT;
		1154	glEnable GL_TEXTURE_2D;
		1155	glEnable GL_DEPTH_TEST;
		1156	glEnable GL_CULL_FACE;
		1157	glShadeModel $::FAST ? GL_FLAT : GL_SMOOTH;
		1158
		1159	glMatrixMode GL_PROJECTION;
		1160	glLoadIdentity;
		1161	glFrustum -1 * ($::WIDTH / $::HEIGHT), 1 * ($::WIDTH / $::HEIGHT), 1, -1, 1, 10000;
		1162	#glOrtho 0, $::WIDTH, 0, $::HEIGHT, -10000, 10000;
		1163	glMatrixMode GL_MODELVIEW;
		1164	glLoadIdentity;
		1165
		1166	glPushMatrix;
		1167	glTranslate 0, 0, -800;
		1168	glScale 1, -1, 1;
		1169	glRotate $NOW * 1000 % 36000 / 5, 0, 1, 0;
		1170	glRotate $NOW * 1000 % 36000 / 6, 1, 0, 0;
		1171	glRotate $NOW * 1000 % 36000 / 7, 0, 0, 1;
		1172	glScale 50, 50, 50;
		1173
		1174	glInterleavedArrays GL_T2F_N3F_V3F, 0, $r->{v};
		1175	while (my ($k, $v) = each %{$r->{g}}) {
		1176	glBindTexture GL_TEXTURE_2D, ($demo{t}{$k}{name} or die);
		1177	glDrawElements GL_TRIANGLES, $v->[0], GL_UNSIGNED_SHORT, $v->[1];
		1178	}
		1179
		1180	glPopMatrix;
		1181
		1182	glShadeModel GL_FLAT;
		1183	glDisable GL_DEPTH_TEST;
		1184	glDisable GL_TEXTURE_2D;
		1185	glDepthMask 0;
		1186
		1187	$WANT_REFRESH++;
		1188	};
		1189
		1190	CFClient::SDL_GL_SwapBuffers;
471	}	1191	}
472		1192
473	my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {	1193	my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {
474	$NOW = time;	1194	$NOW = time;
475		1195
476	($SDL_CB{$SDL_EV->type} || sub { warn "unhandled event ", $SDL_EV->type })->()	1196	($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
477	while $SDL_EV->poll;	1197	for CFClient::SDL_PollEvent;
478		1198
479	if (%animate_object) {	1199	if (%animate_object) {
480	$_->animate ($LAST_REFRESH - $NOW) for values %animate_object;	1200	$_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
481	$want_refresh++;	1201	$WANT_REFRESH++;
482	}	1202	}
483		1203
484	if ($want_refresh) {	1204	if ($WANT_REFRESH) {
485	force_refresh;	1205	force_refresh;
486	} else {	1206	} else {
487	$can_refresh = 1;	1207	$CAN_REFRESH = 1;
488	}	1208	}
489	});	1209	});
490
491	sub refresh {
492	$want_refresh++;
493	}
494		1210
495	sub animation_start {	1211	sub animation_start {
496	my ($widget) = @_;	1212	my ($widget) = @_;
497	$animate_object{$widget} = $widget;	1213	$animate_object{$widget} = $widget;
498	}	1214	}
…		…
502	delete $animate_object{$widget};	1218	delete $animate_object{$widget};
503	}	1219	}
504		1220
505	@conn::ISA = Crossfire::Protocol::;	1221	@conn::ISA = Crossfire::Protocol::;
506		1222
		1223	sub conn::new {
		1224	my $class = shift;
		1225
		1226	my $self = $class->Crossfire::Protocol::new (@_);
		1227
		1228	$MAPWIDGET->clr_commands;
		1229
		1230	my $parser = new Pod::POM;
		1231	my $pod = $parser->parse_file (CFClient::find_rcfile "pod/command_help.pod");
		1232
		1233	for my $head2 ($pod->head2) {
		1234	$head2->title =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x
		1235	or next;
		1236
		1237	my $cmd = $1;
		1238	my @args = split /\|/, $2;
		1239	@args = (".*") unless @args;
		1240
		1241	my $text = CFClient::pod_to_pango $head2->content;
		1242
		1243	for my $arg (@args) {
		1244	$arg = $arg eq ".*" ? "" : " $arg";
		1245
		1246	$MAPWIDGET->add_command ("$cmd$arg", $text);
		1247	}
		1248	}
		1249
		1250	$self->{noface} = new_from_file CFClient::Texture
		1251	CFClient::find_rcfile "noface.png", minify => 1, mipmap => 1;
		1252
		1253	$self
		1254	}
		1255
		1256	sub conn::stats_update {
		1257	my ($self, $stats) = @_;
		1258
		1259	if (my $exp = $stats->{Crossfire::Protocol::CS_STAT_EXP64}) {
		1260	my $diff = $exp - $self->{prev_exp};
		1261	$STATUSBOX->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5)
		1262	if exists $self->{prev_exp} && $diff;
		1263	$self->{prev_exp} = $exp;
		1264	}
		1265
		1266	update_stats_window ($stats);
		1267	}
		1268
507	sub conn::user_send {	1269	sub conn::user_send {
508	my ($self, $command) = @_;	1270	my ($self, $command) = @_;
509		1271
510	$self->send ($command);	1272	$self->send_command ($command);
511	status $command;	1273	status $command;
512	}	1274	}
513		1275
514	sub conn::map_scroll {	1276	sub conn::map_scroll {
515	my ($self, $dx, $dy) = @_;	1277	my ($self, $dx, $dy) = @_;
…		…
534		1296
535	my ($hash, $x, $y, $w, $h) = @$map_info;	1297	my ($hash, $x, $y, $w, $h) = @$map_info;
536		1298
537	my $data = $MAP->get_rect ($x, $y, $w, $h);	1299	my $data = $MAP->get_rect ($x, $y, $w, $h);
538	$MAPCACHE->put ($hash => Compress::LZF::compress $data);	1300	$MAPCACHE->put ($hash => Compress::LZF::compress $data);
539
540	warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#	1301	#warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
541
542	}	1302	}
543		1303
544	sub conn::map_clear {	1304	sub conn::map_clear {
545	my ($self) = @_;	1305	my ($self) = @_;
546		1306
547	$self->flush_map;	1307	$self->flush_map;
548	delete $self->{neigh};	1308	delete $self->{neigh_map};
549		1309
550	$MAP->clear;	1310	$MAP->clear;
551	}	1311	}
552		1312
553		1313
554	sub conn::load_map($$$) {	1314	sub conn::load_map($$$) {
555	my ($self, $hash, $x, $y) = @_;	1315	my ($self, $hash, $x, $y) = @_;
556		1316
557	if (defined (my $data = $MAPCACHE->get ($hash))) {	1317	if (defined (my $data = $MAPCACHE->get ($hash))) {
558	$data = Compress::LZF::decompress $data;	1318	$data = Compress::LZF::decompress $data;
559	warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#	1319	#warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
560	for my $id ($MAP->set_rect ($x, $y, $data)) {	1320	for my $id ($MAP->set_rect ($x, $y, $data)) {
561	my $data = $TILECACHE->get ($id)	1321	my $data = $TILECACHE->get ($id)
562	or next;	1322	or next;
563		1323
564	$self->set_texture ($id => $data);	1324	$self->set_texture ($id => $data);
565	}	1325	}
566	}	1326	}
567	}	1327	}
568		1328
		1329	# hardcode /world/world_xxx_xxx map names, the savings are enourmous,
		1330	# (server resource,s latency, bandwidth), so this hack is warranted.
		1331	# the right fix is to make real tiled maps with an overview file
		1332	sub conn::send_mapinfo {
		1333	my ($self, $data, $cb) = @_;
		1334
		1335	if ($self->{map_info}[0] =~ m%^/world/world_(\d\d\d)_(\d\d\d)$%) {
		1336	my ($wx, $wy) = ($1, $2);
		1337
		1338	if ($data =~ /^spatial ([1-4]+)$/) {
		1339	my @dx = (0, 0, 1, 0, -1);
		1340	my @dy = (0, -1, 0, 1, 0);
		1341	my ($dx, $dy);
		1342
		1343	for (split //, $1) {
		1344	$dx += $dx[$_];
		1345	$dy += $dy[$_];
		1346	}
		1347
		1348	$cb->(spatial => 15,
		1349	$self->{map_info}[1] - $MAP->ox + $dx * 50,
		1350	$self->{map_info}[2] - $MAP->oy + $dy * 50,
		1351	50, 50,
		1352	sprintf "/world/world_%03d_%03d", $wx + $dx, $wy + $dy
		1353	);
		1354
		1355	return;
		1356	}
		1357	}
		1358
		1359	$self->SUPER::send_mapinfo ($data, $cb);
		1360	}
		1361
		1362	# this method does a "flood fill" into every tile direction
		1363	# it assumes that tiles are arranged in a rectangular grid,
		1364	# i.e. a map is the same as the left of the right map etc.
		1365	# failure to comply are harmless and result in display errors
		1366	# at worst.
569	sub conn::flood_fill {	1367	sub conn::flood_fill {
570	my ($self, $path, $hash, $flags, $x0, $y0, $x1, $y1) = @_;	1368	my ($self, $block, $gx, $gy, $path, $hash, $flags) = @_;
571		1369
572	for my $tile (1..4) {	1370	# the server does not allow map paths > 6
573	next if $self->{neigh}{$hash}[$tile];	1371	return if 7 <= length $path;
		1372
		1373	my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
		1374
		1375	for (
		1376	[1, 3, 0, -1],
		1377	[2, 4, 1, 0],
		1378	[3, 1, 0, 1],
		1379	[4, 2, -1, 0],
		1380	) {
		1381	my ($tile, $tile2, $dx, $dy) = @$_;
		1382
		1383	next if $block & (1 << $tile);
		1384	my $block = $block | (1 << $tile2);
		1385
		1386	my $gx = $gx + $dx;
		1387	my $gy = $gy + $dy;
		1388
574	next unless $flags & (1 << ($tile - 1));	1389	next unless $flags & (1 << ($tile - 1));
		1390	next if $self->{neigh_grid}{$gx, $gy}++;
575		1391
576	my $neigh = $self->{neigh}{$hash} ||= [];	1392	my $neigh = $self->{neigh_map}{$hash} ||= [];
577		1393	if (my $info = $neigh->[$tile]) {
578	$self->send_mapinfo ("spatial $path$tile", sub {
579	my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;	1394	my ($flags, $x, $y, $w, $h, $hash) = @$info;
580		1395
581	warn "map<$path>_$tile=<$mode,$x,$y,$w,$h,$hash>\n";#d#	1396	$self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
582	return if $mode ne "spatial";
583
584	$x += $MAP->ox;
585	$y += $MAP->oy;
586
587	$self->load_map ($hash, $x, $y);
588
589	$neigh->[$tile] = [$x, $y, $w, $h];
590
591	$self->flood_fill ("$path$tile", $hash, $flags, $x0, $y0, $x1, $y1)
592	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;	1397	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
		1398
		1399	} else {
		1400	$self->send_mapinfo ("spatial $path$tile", sub {
		1401	my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
		1402
		1403	return if $mode ne "spatial";
		1404
		1405	$x += $MAP->ox;
		1406	$y += $MAP->oy;
		1407
		1408	$self->load_map ($hash, $x, $y)
		1409	unless $self->{neigh_map}{$hash}[5]++;#d#
		1410
		1411	$neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
		1412
		1413	$self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
		1414	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
		1415	});
593	});	1416	}
594	}	1417	}
595	}	1418	}
596		1419
597	sub conn::map_change {	1420	sub conn::map_change {
598	my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;	1421	my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
599		1422
600	$self->flush_map;	1423	$self->flush_map;
601		1424
602	my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);	1425	my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
603		1426
604	warn "$ox $oy map_info<$flags, $x, $y, $w, $h, $hash>\n";#d#	1427	my $mapmapw = $MAPMAP->{w};
		1428	my $mapmaph = $MAPMAP->{h};
605		1429
606	my $mapmapw = 250;	1430	$self->{neigh_rect} = [
607	my $mapmaph = 250;	1431	$ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
		1432	$ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
		1433	];
608		1434
609	$self->flood_fill ("", $hash, $flags,	1435	delete $self->{neigh_grid};
610	$ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
611	$ox + $mapmapw * 0.5, $oy + $mapmapw * 0.5);
612		1436
613	$x += $ox;	1437	$x += $ox;
614	$y += $oy;	1438	$y += $oy;
615		1439
616	$self->{map_info} = [$hash, $x, $y, $w, $h];	1440	$self->{map_info} = [$hash, $x, $y, $w, $h];
617		1441
		1442	(my $map = $hash) =~ s/^.*?\/([^\/]+)$/\1/;
		1443	$STATWIDS->{map}->set_text ("Map: " . $map);
		1444
618	$self->load_map ($hash, $x, $y);	1445	$self->load_map ($hash, $x, $y);
		1446	$self->flood_fill (0, 0, 0, "", $hash, $flags);
619	}	1447	}
620		1448
621	sub conn::face_find {	1449	sub conn::face_find {
622	my ($self, $facenum, $face) = @_;	1450	my ($self, $facenum, $face) = @_;
623		1451
…		…
625		1453
626	my $id = $FACEMAP->get ($hash);	1454	my $id = $FACEMAP->get ($hash);
627		1455
628	unless ($id) {	1456	unless ($id) {
629	# create new id for face	1457	# create new id for face
630	# i love transactions	1458	# I love transactions
631	for (1..100) {	1459	for (1..100) {
632	my $txn = $CFClient::DB_ENV->txn_begin;	1460	my $txn = $CFClient::DB_ENV->txn_begin;
633	my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);	1461	my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);
634	if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {	1462	if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
635	$id++;	1463	$id = ($id || 16) + 1;
636	if ($FACEMAP->put (id => $id) == 0	1464	if ($FACEMAP->put (id => $id) == 0
637	&& $FACEMAP->put ($hash => $id) == 0) {	1465	&& $FACEMAP->put ($hash => $id) == 0) {
638	$txn->txn_commit;	1466	$txn->txn_commit;
639		1467
640	goto gotid;	1468	goto gotid;
…		…
647	}	1475	}
648		1476
649	gotid:	1477	gotid:
650	$face->{id} = $id;	1478	$face->{id} = $id;
651	$MAP->set_face ($facenum => $id);	1479	$MAP->set_face ($facenum => $id);
		1480	$self->{faceid}[$facenum] = $id;#d#
		1481
652	$TILECACHE->get ($id)	1482	$TILECACHE->get ($id) || do {
		1483	my $tex = $self->{noface};
		1484	$MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
		1485	undef
		1486	};
653	}	1487	}
654		1488
655	sub conn::face_update {	1489	sub conn::face_update {
656	my ($self, $facenum, $face) = @_;	1490	my ($self, $facenum, $face) = @_;
657		1491
…		…
664	my ($self, $id, $data) = @_;	1498	my ($self, $id, $data) = @_;
665		1499
666	$self->{texture}[$id] ||= do {	1500	$self->{texture}[$id] ||= do {
667	my $tex =	1501	my $tex =
668	new_from_image CFClient::Texture	1502	new_from_image CFClient::Texture
669	$data, minify => 1;	1503	$data, minify => 1, mipmap => 1;
670		1504
671	$MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});	1505	$MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
672	$MAPWIDGET->update;	1506	$MAPWIDGET->update;
673		1507
674	$tex	1508	$tex
675	};	1509	};
676	}	1510	}
677		1511
		1512	sub conn::sound_play {
		1513	my ($self, $x, $y, $soundnum, $type) = @_;
		1514
		1515	$SDL_MIXER
		1516	or return;
		1517
		1518	my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
		1519	or return;
		1520
		1521	$chunk->play;
		1522	# warn "sound $x,$y,$soundnum,$type\n";#d#
		1523	}
		1524
		1525	my $LAST_QUERY; # server is stupid, stupid, stupid
		1526
678	sub conn::query {	1527	sub conn::query {
679	my ($self, $flags, $prompt) = @_;	1528	my ($self, $flags, $prompt) = @_;
680		1529
681	#TODO	1530	$prompt = $LAST_QUERY unless length $prompt;
682	warn "<<<<QUERY:$flags:$prompt>>>\n";#d#	1531	$LAST_QUERY = $prompt;
		1532
		1533	my $dialog = new CFClient::UI::FancyFrame
		1534	title => "Query",
		1535	child => my $vbox = new CFClient::UI::VBox;
		1536
		1537	$vbox->add (new CFClient::UI::Label
		1538	max_w => $::WIDTH * 0.4,
		1539	text => $prompt);
		1540
		1541	if ($flags & Crossfire::Protocol::CS_QUERY_YESNO) {
		1542	$vbox->add (my $hbox = new CFClient::HBox);
		1543	$hbox->add (new CFClient::Button
		1544	text => "No",
		1545	connect_activate => sub {
		1546	$self->send ("reply n");
		1547	$dialog->destroy;
		1548	$MAPWIDGET->focus_in;
		1549	}
		1550	);
		1551	$hbox->add (new CFClient::Button
		1552	text => "Yes",
		1553	connect_activate => sub {
		1554	$self->send ("reply y");
		1555	$dialog->destroy;
		1556	$MAPWIDGET->focus_in;
		1557	},
		1558	);
		1559
		1560	$dialog->focus_in;
		1561
		1562	} elsif ($flags & Crossfire::Protocol::CS_QUERY_SINGLECHAR) {
		1563	$dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";
		1564	$vbox->add (my $entry = new CFClient::UI::Entry
		1565	connect_changed => sub {
		1566	$self->send ("reply $_[1]");
		1567	$dialog->destroy;
		1568	$MAPWIDGET->focus_in;
		1569	},
		1570	);
		1571
		1572	$entry->focus_in;
		1573
		1574	} else {
		1575	$dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
		1576
		1577	$vbox->add (my $entry = new CFClient::UI::Entry
		1578	$flags & Crossfire::Protocol::CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (),
		1579	connect_activate => sub {
		1580	$self->send ("reply $_[1]");
		1581	$dialog->destroy;
		1582	$MAPWIDGET->focus_in;
		1583	},
		1584	);
		1585
		1586	$entry->focus_in;
		1587	}
		1588
		1589	$dialog->show_centered;
683	}	1590	}
684		1591
685	sub conn::drawinfo {	1592	sub conn::drawinfo {
686	my ($self, $color, $text) = @_;	1593	my ($self, $color, $text) = @_;
687		1594
…		…
699	[0.55, 0.41, 0.13],	1606	[0.55, 0.41, 0.13],
700	[0.99, 0.77, 0.26],	1607	[0.99, 0.77, 0.26],
701	[0.74, 0.65, 0.41],	1608	[0.74, 0.65, 0.41],
702	);	1609	);
703		1610
		1611	my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
		1612
		1613	$text = CFClient::UI::Label::escape $text;
		1614	$text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g;
		1615	$text =~ s/\[color=(.*?)\](.*?)\[\/color\]/<span foreground='\1'>\2<\/span>/g;
		1616
704	$LOGVIEW->add_paragraph ($color[$color], $text);	1617	$LOGVIEW->add_paragraph ($color[$color],
		1618	join "\n", map "$time $_", split /\n/, $text);
		1619
		1620	$STATUSBOX->add ($text,
		1621	group => $text,
		1622	fg => $color[$color],
		1623	timeout => 60,
		1624	tooltip_font => $::FONT_FIXED,
		1625	);
		1626	}
		1627
		1628	sub conn::drawextinfo {
		1629	my ($self, $color, $type, $subtype, $message) = @_;
		1630
		1631	$self->drawinfo ($color, $message);
		1632	}
		1633
		1634	sub conn::spell_add {
		1635	my ($self, $spell) = @_;
		1636
		1637	# TODO
		1638	# create a widget dynamically, using spell face (CF::Protocol downloads them)
		1639	$MAPWIDGET->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message});
		1640	$MAPWIDGET->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message});
		1641	}
		1642
		1643	sub conn::spell_delete {
		1644	my ($self, $spell) = @_;
		1645	}
		1646
		1647	sub conn::addme_success {
		1648	my ($self) = @_;
		1649
		1650	$self->send ("command output-sync $CFG->{output_sync}");
		1651	$self->send ("command output-count $CFG->{output_count}");
		1652
		1653	my $parser = new Pod::POM;
		1654	my $pod = $parser->parse_file (CFClient::find_rcfile "pod/skill_help.pod");
		1655
		1656	my %skill_tooltip;
		1657
		1658	for my $head2 ($pod->head2) {
		1659	$skill_tooltip{$head2->title} = CFClient::pod_to_pango $head2->content;
		1660	}
		1661
		1662	for my $skill (values %{$self->{skill_info}}) {
		1663	$MAPWIDGET->add_command ("ready_skill $skill",
		1664	(CFClient::UI::Label::escape "Ready the skill '$skill'\n\n")
		1665	. $skill_tooltip{$skill});
		1666	$MAPWIDGET->add_command ("use_skill $skill",
		1667	(CFClient::UI::Label::escape "Immediately use the skill '$skill'\n\n")
		1668	. $skill_tooltip{$skill});
		1669	}
		1670	}
		1671
		1672	sub conn::eof {
		1673	$MAPWIDGET->clr_commands;
		1674
		1675	stop_game;
		1676	}
		1677
		1678	sub update_floorbox {
		1679	$CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
		1680	return unless $CONN;
		1681
		1682	$FLOORBOX->clear;
		1683	$FLOORBOX->add (new CFClient::UI::Empty expand => 1);
		1684
		1685	my $count = 7;
		1686	for (@{ $CONN->{container}{0} }) {
		1687	if (--$count) {
		1688	$FLOORBOX->add (new CFClient::UI::InventoryItem item => $_);
		1689	} else {
		1690	$FLOORBOX->add (new CFClient::UI::Label text => "More...");
		1691	last;
		1692	}
		1693	}
		1694	});
		1695
		1696	$WANT_REFRESH++;
		1697	}
		1698
		1699	sub conn::container_add {
		1700	my ($self, $tag, $items) = @_;
		1701
		1702	#d# print "container_add: container $tag ($self->{player}{tag})\n";
		1703
		1704	if ($tag == 0) {
		1705	update_floorbox;
		1706	$OPENCONT = 0;
		1707	$INVR_LBL->set_text ("Floor");
		1708	$INVR->set_items ($self->{container}{0});
		1709	} elsif ($tag == $self->{player}{tag}) {
		1710	$INVR_LBL->set_text ("Player");
		1711	$INV->set_items ($self->{container}{$self->{player}{tag}})
		1712	} else {
		1713	$OPENCONT = $tag;
		1714	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
		1715	$INVR->set_items ($self->{container}{$tag});
		1716	}
		1717
		1718	# $self-<{player}{tag} => player inv
		1719	#use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
		1720	}
		1721
		1722	sub conn::container_clear {
		1723	my ($self, $tag) = @_;
		1724
		1725	#d# print "container_clear: container $tag ($self->{player}{tag})\n";
		1726
		1727	if ($tag == 0) {
		1728	update_floorbox;
		1729	$OPENCONT = 0;
		1730	$INVR_LBL->set_text ("Floor");
		1731	$INVR->set_items ($self->{container}{0});
		1732	} elsif ($tag == $self->{player}{tag}) {
		1733	$INVR_LBL->set_text ("Player");
		1734	$INV->set_items ($self->{container}{$tag})
		1735	} else {
		1736	$OPENCONT = $tag;
		1737	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
		1738	$INVR->set_items ($self->{container}{$tag});
		1739	}
		1740
		1741	# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
		1742	}
		1743
		1744	sub conn::item_delete {
		1745	my ($self, @items) = @_;
		1746
		1747	for (@items) {
		1748	#d# print "item_delete: $_->{tag} from $_->{container} ($self->{player}{tag})\n";
		1749
		1750	if ($_->{container} == 0) {
		1751	update_floorbox;
		1752	$OPENCONT = 0;
		1753	$INVR_LBL->set_text ("Floor");
		1754	$INVR->set_items ($self->{container}{0});
		1755	} elsif ($_->{container} == $self->{player}{tag}) {
		1756	$INVR_LBL->set_text ("Player");
		1757	$INV->set_items ($self->{container}{$self->{player}{tag}})
		1758	} else {
		1759	$OPENCONT = $_->{container};
		1760	$INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
		1761	$INVR->set_items ($self->{container}{$_->{container}});
		1762	}
		1763	}
		1764	}
		1765
		1766	sub conn::item_update {
		1767	my ($self, $item) = @_;
		1768
		1769	#d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($OPENCONT)\n";
		1770
		1771	if ($item->{tag} == $OPENCONT && not ($item->{flags} & Crossfire::Protocol::F_OPEN)) {
		1772	$OPENCONT = 0;
		1773	$INVR_LBL->set_text ("Floor");
		1774	$INVR->set_items ($self->{container}{0});
		1775
		1776	$item->{widget}->update_item
		1777	if $item->{widget};
		1778	} else {
		1779	if ($item->{container} == 0) {
		1780	update_floorbox;
		1781	$OPENCONT = 0;
		1782	$INVR_LBL->set_text ("Floor");
		1783	$INVR->set_items ($self->{container}{0});
		1784	} elsif ($item->{container} == $self->{player}{tag}) {
		1785	$INV->set_items ($self->{container}{$item->{container}})
		1786	}
		1787	}
705	}	1788	}
706		1789
707	%SDL_CB = (	1790	%SDL_CB = (
708	SDL_QUIT() => sub {	1791	CFClient::SDL_QUIT => sub {
709	Event::unloop -1;	1792	Event::unloop -1;
710	},	1793	},
711	SDL_VIDEORESIZE() => sub {	1794	CFClient::SDL_VIDEORESIZE => sub {
712	},	1795	},
713	SDL_VIDEOEXPOSE() => sub {	1796	CFClient::SDL_VIDEOEXPOSE => sub {
714	refresh;	1797	CFClient::UI::full_refresh;
715	},	1798	},
716	SDL_KEYDOWN() => sub {
717	if ($SDL_EV->key_mod & KMOD_ALT && $SDL_EV->key_sym == SDLK_RETURN) {
718	# alt-enter
719	destroy_screen;
720	$CFG->{fullscreen} = !$CFG->{fullscreen};
721	init_screen;
722	} else {
723	CFClient::UI::feed_sdl_key_down_event ($SDL_EV);
724	}
725	},
726	SDL_KEYUP() => sub {
727	CFClient::UI::feed_sdl_key_up_event ($SDL_EV);
728	},
729	SDL_MOUSEMOTION() => sub {
730	CFClient::UI::feed_sdl_motion_event ($SDL_EV);
731	},
732	SDL_MOUSEBUTTONDOWN() => sub {
733	CFClient::UI::feed_sdl_button_down_event ($SDL_EV);
734	},
735	SDL_MOUSEBUTTONUP() => sub {
736	CFClient::UI::feed_sdl_button_up_event ($SDL_EV);
737	},
738	SDL_ACTIVEEVENT() => sub {	1799	CFClient::SDL_ACTIVEEVENT => sub {
739	# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#	1800	# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
740	},	1801	},
		1802	CFClient::SDL_KEYDOWN => sub {
		1803	if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
		1804	# alt-enter
		1805	video_shutdown;
		1806	$CFG->{fullscreen} = !$CFG->{fullscreen};
		1807	video_init;
		1808	} else {
		1809	CFClient::UI::feed_sdl_key_down_event ($_[0]);
		1810	}
		1811	},
		1812	CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
		1813	CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
		1814	CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
		1815	CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
		1816	CFClient::SDL_USEREVENT => sub {
		1817	if ($_[0]{code} == 1) {
		1818	audio_channel_finished $_[0]{data1};
		1819	} elsif ($_[0]{code} == 0) {
		1820	audio_music_finished;
		1821	}
		1822	},
741	);	1823	);
742		1824
743	#############################################################################	1825	#############################################################################
744		1826
745	$TILECACHE = CFClient::db_table "tilecache";	1827	$SIG{INT} = $SIG{TERM} = sub { exit };
746	$FACEMAP = CFClient::db_table "facemap";
747
748	CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
749
750	my %DEF_CFG = (
751	sdl_mode => 0,
752	width => 640,
753	height => 480,
754	fullscreen => 0,
755	fast => 0,
756	fow_enable => 1,
757	fow_intensity => 0.45,
758	fow_smooth => 0,
759	log_fontsize => 14,
760	mapsize => 100,
761	host => "crossfire.schmorp.de",
762	say_command => 'say',
763	);
764
765	while (my ($k, $v) = each %DEF_CFG) {
766	$CFG->{$k} = $v unless exists $CFG->{$k};
767	}
768
769	sdl_init;
770
771	@SDL_MODES = reverse
772	grep $_->[0] >= 640 && $_->[1] >= 480,
773	map [SDL::RectW ($_), SDL::RectH ($_)],
774	@{ SDL::ListModes 0, SDL_FULLSCREEN | SDL_HWSURFACE | SDL_OPENGL };
775
776	@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
777
778	$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
779
780	init_screen;
781		1828
782	{	1829	{
783	my @fonts = map CFClient::find_rcfile $_, qw(uifont.ttf uifontb.ttf uifonti.ttf uifontbi.ttf);	1830	local $SIG{__DIE__} = sub { CFClient::fatal $_[0] };
784		1831
		1832	CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
		1833
		1834	$TILECACHE = CFClient::db_table "tilecache";
		1835	$FACEMAP = CFClient::db_table "facemap";
		1836
		1837	my %DEF_CFG = (
		1838	sdl_mode => 0,
		1839	width => 640,
		1840	height => 480,
		1841	fullscreen => 0,
		1842	fast => 0,
		1843	map_scale => 1,
		1844	fow_enable => 1,
		1845	fow_intensity => 0.45,
		1846	fow_smooth => 0,
		1847	gui_fontsize => 1,
		1848	log_fontsize => 1,
		1849	gauge_fontsize=> 1,
		1850	gauge_size => 0.35,
		1851	stat_fontsize => 1,
		1852	mapsize => 100,
		1853	host => "crossfire.schmorp.de",
		1854	say_command => 'say',
		1855	audio_enable => 1,
		1856	bgm_enable => 1,
		1857	bgm_volume => 0.25,
		1858	output_sync => 1,
		1859	output_count => 1,
		1860	);
		1861
		1862	while (my ($k, $v) = each %DEF_CFG) {
		1863	$CFG->{$k} = $v unless exists $CFG->{$k};
		1864	}
		1865
		1866	sdl_init;
		1867
		1868	@SDL_MODES = reverse
		1869	grep $_->[0] >= 640 && $_->[1] >= 480,
		1870	CFClient::SDL_ListModes;
		1871
		1872	@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
		1873
		1874	$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
		1875
		1876	{
		1877	my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
		1878	DejaVuSans.ttf
		1879	DejaVuSansMono.ttf
		1880	DejaVuSans-Bold.ttf
		1881	DejaVuSansMono-Bold.ttf
		1882	DejaVuSans-Oblique.ttf
		1883	DejaVuSansMono-Oblique.ttf
		1884	DejaVuSans-BoldOblique.ttf
		1885	DejaVuSansMono-BoldOblique.ttf
		1886	);
		1887
785	CFClient::add_font $_ for @fonts;	1888	CFClient::add_font $_ for @fonts;
786	CFClient::set_font $fonts[0];	1889
		1890	CFClient::pango_init;
		1891
		1892	$FONT_PROP = new_from_file CFClient::Font $fonts[0];
		1893	$FONT_FIXED = new_from_file CFClient::Font $fonts[1];
		1894
		1895	$FONT_PROP->make_default;
		1896	}
		1897
		1898	# compare mono (ft) vs. rgba (cairo)
		1899	# ft - 1.8s, cairo 3s, even in alpha-only mode
		1900	# for my $rgba (0..1) {
		1901	# my $t1 = Time::HiRes::time;
		1902	# for (1..1000) {
		1903	# my $layout = CFClient::Layout->new ($rgba);
		1904	# $layout->set_text ("hallo" x 100);
		1905	# $layout->render;
		1906	# }
		1907	# my $t2 = Time::HiRes::time;
		1908	# warn $t2-$t1;
		1909	# }
		1910
		1911	video_init;
		1912	audio_init;
787	}	1913	}
788		1914
789	Event::loop;	1915	Event::loop;
790		1916
		1917	END { CFClient::SDL_Quit }
791		1918
		1919	=head1 NAME
		1920
		1921	pclient - A Crossfire+ and Crossfire game client
		1922
		1923	=head1 SYNOPSIS
		1924
		1925	Just run it - no commandline arguments are supported.
		1926
		1927	=head1 USAGE
		1928
		1929	Pclient utilises OpenGL for all UI elements and the game. It is supposed to be used
		1930	fullscreen and interactively.
		1931
		1932	=head1 AUTHOR
		1933
		1934	Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
		1935
		1936
		1937

Diff Legend

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