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.77 by root, Tue Apr 11 22:49:13 2006 UTC vs.
Revision 1.178 by root, Tue Apr 25 08:39:18 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	use Glib;	6	BEGIN {
7	use Gtk2 -init;	7	if (%PAR::LibCache) {
		8	@INC = grep ref, @INC; # weed out all paths except pars loader refs
8		9
9	use SDL;	10	while (my ($filename, $zip) = each %PAR::LibCache) {
10	use SDL::App;	11	for ($zip->memberNames) {
		12	next unless /^\/root\/(.*)/;
		13	$zip->extractMember ($_, "$ENV{PAR_TEMP}/$1")
		14	unless -e "$ENV{PAR_TEMP}/$1";
		15	}
		16	}
		17
		18	unshift @INC, $ENV{PAR_TEMP};
		19
		20	if ($^O eq "MSWin32") {
		21	$ENV{GTK_RC_FILES} = "$ENV{PAR_TEMP}/share/themes/MS-Windows/gtk-2.0/gtkrc";
		22	}
		23	}
		24	}
		25
		26	# need to do it again because that pile of garbage called PAR nukes it before main
		27	unshift @INC, $ENV{PAR_TEMP};
		28
		29	use Time::HiRes 'time';
11	use SDL::Event;	30	use Event;
12	use SDL::Surface;
13	use SDL::OpenGL;
14	use SDL::OpenGL::Constants;
15		31
16	use Crossfire;	32	use Crossfire;
17	use Crossfire::Protocol;	33	use Crossfire::Protocol;
18		34
		35	use Compress::LZF;
		36
19	use CFClient;	37	use CFClient;
20	use CFClient::UI;	38	use CFClient::UI;
		39	use CFClient::MapWidget;
		40
		41	$Event::DIED = sub {
		42	CFClient::error $_[1];
		43	};
		44
		45	#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#
21		46
22	our $VERSION = '0.1';	47	our $VERSION = '0.1';
23		48
24	my $MAX_FPS = 60;	49	my $MAX_FPS = 60;
25	my $TICKS_PER_FRAME = int 1000 / $MAX_FPS - 1; # min ticks per frame	50	my $MIN_FPS = 5; # unused as of yet
26		51
		52	our $META_SERVER = "crossfire.real-time.com:13326";
		53
		54	our $FACEMAP;
		55	our $TILECACHE;
27	our $FACECACHE;	56	our $MAPCACHE;
		57
		58	our $LAST_REFRESH;
		59	our $NOW;
28		60
29	our $CFG;	61	our $CFG;
30	our $CONN;	62	our $CONN;
		63	our $FAST; # fast, low-quality mode, possibly useful for software-rendering
31		64
32	our @SDL_MODES;	65	our @SDL_MODES;
33	our $WIDTH;	66	our $WIDTH;
34	our $HEIGHT;	67	our $HEIGHT;
35	our $FULLSCREEN;	68	our $FULLSCREEN;
		69	our $FONTSIZE;
36		70
37	our $NOW;	71	our $FONT_PROP;
		72	our $FONT_FIXED;
38		73
		74	our $MAP;
39	our $MAPWIDGET;	75	our $MAPWIDGET;
40	our $FONTSIZE;	76	our $BUTTONBAR;
		77	our $LOGVIEW;
		78	our $CONSOLE;
		79	our $METASERVER;
41		80
		81	our $FLOORBOX;
		82	our $GAUGES;
		83	our $STATWIDS;
		84
42	our $SDL_TIMER;	85	our $SDL_ACTIVE;
43	our $SDL_APP;
44	our $SDL_EV;
45	our %SDL_CB;	86	our %SDL_CB;
		87
		88	our $SDL_MIXER;
		89	our @SOUNDS; # event => file mapping
		90	our %AUDIO_CHUNKS; # audio files
46		91
47	our $ALT_ENTER_MESSAGE;	92	our $ALT_ENTER_MESSAGE;
48	our $STATUS_LINE;	93	our $STATUS_LINE;
49	our $DEBUG_STATUS;	94	our $DEBUG_STATUS;
50		95
51	my $last_refresh;	96	sub status {
52	my %ANIMATE;	97	$STATUS_LINE->set_text ($_[0]);
53	my $refresh_handler;	98	$STATUS_LINE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $STATUS_LINE->{h});
		99	}
54		100
55	our ($tw, $te); # Test widget #d#	101	sub debug {
		102	$DEBUG_STATUS->set_text ($_[0]);
		103	$DEBUG_STATUS->move ($WIDTH - $DEBUG_STATUS->{w}, 0, $DEBUG_STATUS->{w}, $DEBUG_STATUS->{h});
		104	}
56		105
57	sub init_screen {	106	sub start_game {
58	$SDL_APP = new SDL::App	107	status "logging in...";
59	-flags => SDL_ANYFORMAT | SDL_HWSURFACE,
60	-title => "Crossfire+ Client",
61	-width => $WIDTH,
62	-height => $HEIGHT,
63	-opengl => 1,
64	-red_size => 5,
65	-green_size => 5,
66	-blue_size => 5,
67	-alpha_size => 0,
68	-double_buffer => 1,
69	-fullscreen => $FULLSCREEN,
70	-resizeable => 0;
71		108
72	$SDL_EV = new SDL::Event;	109	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
73	$SDL_EV->set_unicode (1);
74		110
75	$SDL_TIMER = add Glib::Timeout 1000 / $MAX_FPS, sub {	111	$MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";
76	($SDL_CB{$SDL_EV->type} || sub { warn "unhandled event ", $SDL_EV->type })->()
77	while $SDL_EV->poll;
78		112
79	1	113	$MAP = new CFClient::Map $mapsize, $mapsize;
80	};
81		114
82	$last_refresh = SDL::GetTicks;	115	my ($host, $port) = split /:/, $CFG->{host};
83
84	CFClient::gl_init;
85
86	$FONTSIZE = int $HEIGHT / 40;
87
88	#############################################################################
89
90	glClearColor 0.45, 0.45, 0.45, 1;
91
92	glEnable GL_TEXTURE_2D;
93	glEnable GL_COLOR_MATERIAL;
94	glShadeModel GL_FLAT;
95	glDisable GL_DEPTH_TEST;
96	glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA;
97
98	#############################################################################
99
100	$DEBUG_STATUS = new CFClient::UI::Label padding => 0;
101	$CFClient::UI::TOPLEVEL->add ($DEBUG_STATUS);
102		116
103	$STATUS_LINE = new CFClient::UI::Label
104	padding => 0,
105	y => $HEIGHT * 49 / 50 - $FONTSIZE;
106	$CFClient::UI::TOPLEVEL->add ($STATUS_LINE);
107
108	$ALT_ENTER_MESSAGE = new CFClient::UI::Label
109	padding => 0,
110	y => $HEIGHT * 49 / 50,
111	height => $HEIGHT / 50,
112	text => "Use <b>Alt-Enter</b> to toggle fullscreen mode";
113	$CFClient::UI::TOPLEVEL->add ($ALT_ENTER_MESSAGE);
114
115	$MAPWIDGET = new CFClient::UI::MapWidget;
116	$CFClient::UI::TOPLEVEL->add ($MAPWIDGET);
117	$MAPWIDGET->focus_in;
118	}
119
120	sub destroy_screen {
121	remove Glib::Source $SDL_TIMER;
122	undef $SDL_APP;
123	undef $SDL_EV;
124	SDL::Quit;
125	}
126
127	sub config_dialog {
128	my $dialog = new CFClient::UI::FancyFrame x => 300, y => 100,
129	child => (my $vbox = new CFClient::UI::VBox);
130	$vbox->add (new CFClient::UI::Label align => 0, text => "Setup");
131	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
132
133	$table->add (0, 0, new CFClient::UI::Label align => 1, text => "Video Mode");
134	$table->add (1, 0, my $hbox = new CFClient::UI::HBox);
135
136	$hbox->add (my $mode_slider = new CFClient::UI::Slider req_w => 100, range => [$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1]);
137	$hbox->add (my $mode_label = new CFClient::UI::Label);
138
139	$mode_slider->connect (changed => sub {
140	my (undef, $value) = @_;
141
142	$CFG->{sdl_mode} = $value = int $value + 0.5;
143	$mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});
144	});
145	$mode_slider->emit (changed => $mode_slider->{range}[0]);
146
147	$table->add (0, 1, new CFClient::UI::Label align => 1, text => "Host");
148	$table->add (1, 1, my $host = new CFClient::UI::Entry text => $CFG->{host});
149
150	$table->add (0, 2, new CFClient::UI::Label align => 1, text => "Port");
151	$table->add (1, 2, my $port = new CFClient::UI::Entry text => $CFG->{port});
152
153	$table->add (0, 3, new CFClient::UI::Label align => 1, text => "Username");
154	$table->add (1, 3, my $user = new CFClient::UI::Entry text => $CFG->{user});
155
156	$table->add (0, 4, new CFClient::UI::Label align => 1, text => "Password");
157	$table->add (1, 4, my $pass = new CFClient::UI::Entry text => $CFG->{password}, hidden => 1);
158
159	$table->add (0, 5, new CFClient::UI::Label align => 1, text => "Map Size");
160	$table->add (1, 5, my $mapsize_slider = new CFClient::UI::Slider req_w => 100, range => [$CFG->{mapsize}, 10, 100 + 1, 1]);
161
162	$CFClient::UI::TOPLEVEL->add ($dialog);
163	}
164
165	sub start_game {
166	$WIDTH = $CFG->{width};
167	$HEIGHT = $CFG->{height};
168	$FULLSCREEN = 0;
169
170	init_screen;
171
172	config_dialog;
173
174	my $mapsize = List::Util::min 64, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
175
176	$CONN = new conn	117	$CONN = new conn
177	host => $CFG->{host},	118	host => $host,
178	port => $CFG->{port},	119	port => $port || 13327,
179	user => $CFG->{user},	120	user => $CFG->{user},
180	pass => $CFG->{password},	121	pass => $CFG->{password},
181	mapw => $mapsize,	122	mapw => $mapsize,
182	maph => $mapsize,	123	maph => $mapsize,
183	;	124	;
184		125
		126	status "login successful";
		127
185	CFClient::lowdelay fileno $CONN->{fh};	128	CFClient::lowdelay fileno $CONN->{fh};
186	}	129	}
187		130
188	sub stop_game {	131	sub stop_game {
189	remove Glib::Source $refresh_handler if $refresh_handler;
190	undef $refresh_handler;
191
192	undef $CONN;	132	undef $CONN;
193	destroy_screen;
194	}	133	}
195		134
196	sub force_refresh {	135	sub client_setup {
197	glViewport 0, 0, $WIDTH, $HEIGHT;	136	my $dialog = new CFClient::UI::FancyFrame
		137	title => "Client Setup",
		138	child => (my $vbox = new CFClient::UI::VBox);
		139	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
198		140
199	glMatrixMode GL_PROJECTION;	141	$table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");
200	glLoadIdentity;	142	$table->add (1, 0, my $hbox = new CFClient::UI::HBox);
201	glOrtho 0, $WIDTH, $HEIGHT, 0, -10000 , 10000;
202	glMatrixMode GL_MODELVIEW;
203	glLoadIdentity;
204		143
205	glClear GL_COLOR_BUFFER_BIT;	144	$hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1]);
		145	$hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");
206		146
207	$CFClient::UI::TOPLEVEL->draw;	147	$mode_slider->connect (changed => sub {
		148	my ($self, $value) = @_;
208		149
209	SDL::GLSwapBuffers;	150	$CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
210	}	151	$mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});
		152	});
		153	$mode_slider->emit (changed => $mode_slider->{range}[0]);
211		154
212	sub debug {	155	my $row = 1;
213	$DEBUG_STATUS->set_text ($_[0]);
214	my ($w, $h) = $DEBUG_STATUS->size_request;
215	$DEBUG_STATUS->size_allocate ($WIDTH - $w, 0, $w, $h);
216	}
217		156
218	my $FPS;	157	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
		158	$table->add (1, $row++, new CFClient::UI::CheckBox
		159	state => $CFG->{fullscreen},
		160	tooltip => "Bring the client into fullscreen mode",
		161	connect_changed => sub {
		162	my ($self, $value) = @_;
		163	$CFG->{fullscreen} = $value;
		164	}
		165	);
219		166
220	sub refresh {	167	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
221	$refresh_handler ||= add Glib::Idle sub {	168	$table->add (1, $row++, new CFClient::UI::CheckBox
222	if ($SDL_APP) {	169	state => $CFG->{fast},
223	$NOW = SDL::GetTicks;	170	tooltip => "Lower the visual quality considerably to speed up rendering.",
		171	connect_changed => sub {
		172	my ($self, $value) = @_;
		173	$CFG->{fast} = $value;
		174	}
		175	);
224		176
225	if ($NOW - $last_refresh < $TICKS_PER_FRAME) {	177	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
226	SDL::Delay $TICKS_PER_FRAME - ($NOW - $last_refresh);	178	$table->add (1, $row++, new CFClient::UI::Slider
227	$NOW = SDL::GetTicks;	179	range => [$CFG->{map_scale}, 0.25, 2, 0.05],
		180	tooltip => "Enlarge or shrink the displayed map",
		181	connect_changed => sub {
		182	my ($self, $value) = @_;
		183	$CFG->{map_scale} = 0.05 * int $value / 0.05;
		184	}
		185	);
		186
		187	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
		188	$table->add (1, $row++, new CFClient::UI::CheckBox
		189	state => $CFG->{fow_enable},
		190	tooltip => "Fog-of-War marks areas that cannot be seen by the player",
		191	connect_changed => sub {
		192	my ($self, $value) = @_;
		193	$CFG->{fow_enable} = $value;
		194	}
		195	);
		196
		197	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
		198	$table->add (1, $row++, new CFClient::UI::Slider
		199	range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001],
		200	tooltip => "The higher the intensity, the lighter the Fog-of-War color",
		201	connect_changed => sub {
		202	my ($self, $value) = @_;
		203	$CFG->{fow_intensity} = $value;
		204	}
		205	);
		206
		207	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
		208	$table->add (1, $row++, new CFClient::UI::CheckBox
		209	state => $CFG->{fow_smooth},
		210	tooltip => "Smooth the Fog-of-War a bit to make it more realistic",
		211	connect_changed => sub {
		212	my ($self, $value) = @_;
		213	$CFG->{fow_smooth} = $value;
		214	status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2;
		215	}
		216	);
		217
		218	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
		219	$table->add (1, $row++, new CFClient::UI::Slider
		220	range => [$CFG->{gui_fontsize}, 0.5, 2, 0.1],
		221	tooltip => "The font size used by most GUI elements",
		222	connect_changed => sub {
		223	$CFG->{gui_fontsize} = 0.1 * int $_[1] * 10;
		224	# $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
		225	}
		226	);
		227
		228	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Server Log Fontsize");
		229	$table->add (1, $row++, new CFClient::UI::Slider
		230	range => [$CFG->{log_fontsize}, 0.5, 2, 0.1],
		231	tooltip => "The font size used by the server log window only",
		232	connect_changed => sub {
		233	$LOGVIEW->set_fontsize ($CFG->{log_fontsize} = 0.1 * int $_[1] * 10);
		234	}
		235	);
		236
		237	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
		238
		239	$table->add (1, $row++, new CFClient::UI::Slider
		240	range => [$CFG->{stat_fontsize}, 0.5, 2, 0.1],
		241	tooltip => "The font size used by the statistics window only",
		242	connect_changed => sub {
		243	$CFG->{stat_fontsize} = 0.1 * int $_[1] * 10;
		244	&set_stats_window_fontsize;
		245	}
		246	);
		247
		248	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
		249	$table->add (1, $row++, new CFClient::UI::Slider
		250	range => [$CFG->{gauge_size}, 0.2, 0.8, 0.02],
		251	tooltip => "Adjust the size of the stats gauges at the bottom right",
		252	connect_changed => sub {
		253	$CFG->{gauge_size} = $_[1];
		254	my $h = int $HEIGHT * $CFG->{gauge_size};
		255	$GAUGES->{win}->set_size ($WIDTH, $h);
		256	$GAUGES->{win}->move (0, $HEIGHT - $h);
		257	}
		258	);
		259
		260	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
		261	$table->add (1, $row++, new CFClient::UI::Slider
		262	range => [$CFG->{gauge_fontsize}, 0.5, 2.0, 0.1],
		263	tooltip => "Adjusts the fontsize of the gauges at the bottom right",
		264	connect_changed => sub {
		265	$CFG->{gauge_fontsize} = 0.1 * int $_[1] * 10;
		266	&set_gauge_window_fontsize;
		267	}
		268	);
		269
		270	$table->add (1, $row++, new CFClient::UI::Button
		271	expand => 1, align => 0, text => "Apply",
		272	tooltip => "Apply the video settings",
		273	connect_activate => sub {
		274	video_shutdown ();
		275	video_init ();
		276	}
		277	);
		278
		279	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");
		280	$table->add (1, $row++, new CFClient::UI::CheckBox
		281	state => $CFG->{audio_enable},
		282	tooltip => "If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.",
		283	connect_changed => sub {
		284	$CFG->{audio_enable} = $_[1];
		285	}
		286	);
		287	# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume");
		288	# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], connect_changed => sub {
		289	# $CFG->{effects_volume} = $_[1];
		290	# });
		291	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");
		292	$table->add (1, $row++, my $hbox = new CFClient::UI::HBox);
		293	$hbox->add (new CFClient::UI::CheckBox
		294	expand => 1, state => $CFG->{bgm_enable},
		295	tooltip => "Enable background music playing",
		296	connect_changed => sub {
		297	$CFG->{bgm_enable} = $_[1];
		298	}
		299	);
		300	$hbox->add (new CFClient::UI::Slider
		301	expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0.1],
		302	tooltip => "The volume of the background music",
		303	connect_changed => sub {
		304	$CFG->{bgm_volume} = $_[1];
		305	CFClient::MixMusic::volume $_[1] * 128;
		306	}
		307	);
		308
		309	$table->add (1, $row++, new CFClient::UI::Button
		310	expand => 1, align => 0, text => "Apply",
		311	tooltip => "Apply the audio settings",
		312	connect_activate => sub {
		313	audio_shutdown ();
		314	audio_init ();
		315	}
		316	);
		317
		318	$dialog
		319	}
		320
		321	sub set_stats_window_fontsize {
		322	for (values %{$STATWIDS}) {
		323	$_->set_fontsize ($::CFG->{stat_fontsize});
		324	}
		325	}
		326
		327	sub set_gauge_window_fontsize {
		328	for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {
		329	$_->set_fontsize ($::CFG->{gauge_fontsize});
		330	}
		331
		332	# local $GAUGES->{win}{parent};#d#
		333	# use PApp::Util; open D, ">:utf8", "d"; print D PApp::Util::dumpval $GAUGES->{win}; close D;
		334	}
		335
		336	sub make_gauge_window {
		337	my $gh = int ($HEIGHT * $CFG->{gauge_size});
		338	# my $gw = int ($WIDTH * $CFG->{gauge_w_size});
		339
		340	my $win = new CFClient::UI::Frame (
		341	y => $HEIGHT - $gh, x => 0, user_w => $WIDTH, user_h => $gh
		342	);
		343	$win->add (my $hbox = new CFClient::UI::HBox
		344	children => [
		345	(new CFClient::UI::HBox expand => 1),
		346	($FLOORBOX = new CFClient::UI::VBox),
		347	(my $vbox = new CFClient::UI::VBox),
		348	],
		349	);
		350
		351	$vbox->add (new CFClient::UI::HBox
		352	expand => 1,
		353	children => [
		354	(new CFClient::UI::Empty expand => 1),
		355	(my $hb = new CFClient::UI::HBox),
		356	],
		357	);
		358
		359	$hb->add (my $hg = new CFClient::UI::Gauge type => 'hp',
		360	tooltip => "Health points - depletes when you get wounded, refills when you heal or idle");
		361	$hb->add (my $mg = new CFClient::UI::Gauge type => 'mana',
		362	tooltip => "Spell points - deplete when you cast wizard spells, refills when you idle");
		363	$hb->add (my $gg = new CFClient::UI::Gauge type => 'grace',
		364	tooltip => "Grace points - deplete when you cast priest spells, refills when you pray");
		365	$hb->add (my $fg = new CFClient::UI::Gauge type => 'food',
		366	tooltip => "Food - depletes with time, faster when you heal or build mana, refills when you eat healthy food");
		367
		368	$vbox->add (my $exp = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
		369	tooltip => "Experience points and level - increases when you kill monsters or successfully use skills");
		370	$vbox->add (my $rng = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
		371	tooltip => "Ranged attack - how you attack when you press shift-cursor (spell, skill, weapon etc.)");
		372
		373	$GAUGES = {
		374	exp => $exp, win => $win, range => $rng,
		375	food => $fg, mana => $mg, hp => $hg, grace => $gg
		376	};
		377
		378	&set_gauge_window_fontsize;
		379
		380	$win
		381	}
		382
		383	sub make_stats_window {
		384	my $tgw = new CFClient::UI::FancyFrame (x => $WIDTH * 2/5, y => 0, title => "Stats");
		385
		386	$tgw->add (my $vb = new CFClient::UI::VBox);
		387	$vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1);
		388	$vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1);
		389
		390	$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
		391
		392	$hb->add (my $tbl = new CFClient::UI::Table expand => 1);
		393
		394	my $black = [0, 0, 0];
		395
		396	$tbl->add (0, 0, $STATWIDS->{st_str} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
		397	$tbl->add (0, 1, $STATWIDS->{st_dex} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
		398	$tbl->add (0, 2, $STATWIDS->{st_con} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
		399	$tbl->add (0, 3, $STATWIDS->{st_int} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
		400	$tbl->add (0, 4, $STATWIDS->{st_wis} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
		401	$tbl->add (0, 5, $STATWIDS->{st_pow} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
		402	$tbl->add (0, 6, $STATWIDS->{st_cha} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
		403
		404	$tbl->add (1, 0, $STATWIDS->{st_str_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Str");
		405	$tbl->add (1, 1, $STATWIDS->{st_dex_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Dex");
		406	$tbl->add (1, 2, $STATWIDS->{st_con_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Con");
		407	$tbl->add (1, 3, $STATWIDS->{st_int_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Int");
		408	$tbl->add (1, 4, $STATWIDS->{st_wis_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Wis");
		409	$tbl->add (1, 5, $STATWIDS->{st_pow_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Pow");
		410	$tbl->add (1, 6, $STATWIDS->{st_cha_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Cha");
		411
		412	$tbl->add (2, 0, $STATWIDS->{st_wc} = new CFClient::UI::Label valign => 0, align => +1, template => "-120");
		413	$tbl->add (2, 1, $STATWIDS->{st_ac} = new CFClient::UI::Label valign => 0, align => +1, template => "-120");
		414	$tbl->add (2, 2, $STATWIDS->{st_dam} = new CFClient::UI::Label valign => 0, align => +1, template => "120");
		415	$tbl->add (2, 3, $STATWIDS->{st_arm} = new CFClient::UI::Label valign => 0, align => +1, template => "120");
		416	$tbl->add (2, 4, $STATWIDS->{st_spd} = new CFClient::UI::Label valign => 0, align => +1, template => "10.54");
		417	$tbl->add (2, 5, $STATWIDS->{st_wspd} = new CFClient::UI::Label valign => 0, align => +1, template => "9");
		418
		419	$tbl->add (3, 0, $STATWIDS->{st_wc_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Wc");
		420	$tbl->add (3, 1, $STATWIDS->{st_ac_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Ac");
		421	$tbl->add (3, 2, $STATWIDS->{st_dam_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Dam");
		422	$tbl->add (3, 3, $STATWIDS->{st_arm_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Arm");
		423	$tbl->add (3, 4, $STATWIDS->{st_spd_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Sp");
		424	$tbl->add (3, 5, $STATWIDS->{st_wspd_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "WSp");
		425
		426	$hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);
		427
		428	my $row = 0;
		429	my $col = 0;
		430
		431	my %resist_names = (
		432	slow => "Slow",
		433	holyw => "Holy Word",
		434	conf => "Confusion",
		435	fire => "Fire",
		436	depl => "Depletion",
		437	magic => "Magic",
		438	drain => "Draining",
		439	acid => "Acid",
		440	pois => "Poison",
		441	para => "Paralysation",
		442	deat => "Death",
		443	phys => "Physical",
		444	blind => "Blind",
		445	fear => "Fear",
		446	tund => "Turn undead",
		447	elec => "Electricity",
		448	cold => "Cold",
		449	ghit => "Ghost hit",
		450	);
		451	for (qw/slow holyw conf fire depl magic
		452	drain acid pois para deat phys
		453	blind fear tund elec cold ghit/)
		454	{
		455	$tbl2->add ($col, $row,
		456	$STATWIDS->{"res_$_"} =
		457	new CFClient::UI::Label
		458	template => "-100%",
		459	align => +1,
		460	valign => 0,
		461	tooltip => $resist_names{$_}
		462	);
		463	$tbl2->add ($col + 1, $row, new CFClient::UI::Image
		464	can_hover => 1,
		465	can_events => 1,
		466	image => "ui/resist/resist_$_.png",
		467	tooltip => $resist_names{$_}
		468	);
		469
		470	$row++;
		471	if ($row % 6 == 0) {
		472	$col += 2;
		473	$row = 0;
		474	}
		475	}
		476
		477	&set_stats_window_fontsize;
		478	update_stats_window ({});
		479
		480	$tgw
		481	}
		482
		483	sub formsep {
		484	reverse join ",", grep length, split /(...)/, reverse $_[0] * 1
		485	}
		486
		487	sub update_stats_window {
		488	my ($stats) = @_;
		489
		490	# i love text protocols!!!
		491	my $hp = $stats->{Crossfire::Protocol::CS_STAT_HP} * 1;
		492	my $hp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXHP} * 1;
		493	my $sp = $stats->{Crossfire::Protocol::CS_STAT_SP} * 1;
		494	my $sp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXSP} * 1;
		495	my $fo = $stats->{Crossfire::Protocol::CS_STAT_FOOD} * 1;
		496	my $fo_m = 999;
		497	my $gr = $stats->{Crossfire::Protocol::CS_STAT_GRACE} * 1;
		498	my $gr_m = $stats->{Crossfire::Protocol::CS_STAT_MAXGRACE} * 1;
		499
		500	$GAUGES->{hp} ->set_value ($hp, $hp_m);
		501	$GAUGES->{mana} ->set_value ($sp, $sp_m);
		502	$GAUGES->{food} ->set_value ($fo, $fo_m);
		503	$GAUGES->{grace} ->set_value ($gr, $gr_m);
		504	$GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::CS_STAT_EXP64})
		505	. " (lvl " . ($stats->{Crossfire::Protocol::CS_STAT_LEVEL} * 1) . ")");
		506	my $rng = $stats->{Crossfire::Protocol::CS_STAT_RANGE};
		507	$rng =~ s/^Range: //; # thank you so much dear server
		508	$GAUGES->{range} ->set_text ("Rng: " . $rng);
		509	my $title = $stats->{Crossfire::Protocol::CS_STAT_TITLE};
		510	$title =~ s/^Player: //;
		511	$STATWIDS->{title} ->set_text ("Title: " . $title);
		512
		513	$STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});
		514	$STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});
		515	$STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9});
		516	$STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6});
		517	$STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7});
		518	$STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22});
		519	$STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});
		520	$STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13});
		521	$STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14});
		522	$STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});
		523	$STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});
		524	$STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_SPEED});
		525	$STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_WEAP_SP});
		526
		527	my %tbl = (
		528	phys => 100,
		529	magic => 101,
		530	fire => 102,
		531	elec => 103,
		532	cold => 104,
		533	conf => 105,
		534	acid => 106,
		535	drain => 107,
		536	ghit => 108,
		537	pois => 109,
		538	slow => 110,
		539	para => 111,
		540	tund => 112,
		541	fear => 113,
		542	depl => 113,
		543	deat => 115,
		544	holyw => 116,
		545	blind => 117
		546	);
		547
		548	for (keys %tbl) {
		549	$STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}});
		550	}
		551
		552	}
		553
		554	sub metaserver_dialog {
		555	my $dialog = new CFClient::UI::FancyFrame
		556	title => "Metaserver",
		557	child => (my $vbox = new CFClient::UI::VBox);
		558
		559	$vbox->add ($dialog->{table} = new CFClient::UI::Table);
		560
		561	$dialog
		562	}
		563
		564	sub update_metaserver {
		565	my ($HOST) = @_;
		566
		567	my $table = $METASERVER->{table};
		568	$table->clear;
		569	$table->add (0, 0, my $label = new CFClient::UI::Label max_w => $WIDTH * 0.8, text => "fetching metaserver list...");
		570
		571	my $buf;
		572
		573	my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;
		574
		575	unless ($fh) {
		576	$label->set_text ("unable to contact metaserver: $!");
		577	return;
		578	}
		579
		580	Event->io (fd => $fh, poll => 'r', cb => sub {
		581	my $res = sysread $fh, $buf, 8192, length $buf;
		582
		583	if (!defined $res) {
		584	$_[0]->w->cancel;
		585	$label->set_text ("error while retrieving server list: $!");
		586	} elsif ($res == 0) {
		587	$_[0]->w->cancel;
		588	status "server list retrieved";
		589
		590	utf8::decode $buf if utf8::valid $buf;
		591
		592	$table->clear;
		593
		594	my @col = qw(Use #Users Host Uptime Version Description);
		595	$table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])
		596	for 0 .. $#col;
		597
		598	my @align = qw(1 0 1 1 -1);
		599
		600	my $y = 0;
		601	for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) {
		602	my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m;
		603
		604	for ($desc) {
		605	s/<br>/\n/gi;
		606	s/<li>/\n· /gi;
		607	s/<.*?>//sgi;
		608	s/&/&amp;/g;
		609	s/</&lt;/g;
		610	s/>/&gt;/g;
		611	}
		612
		613	$uptime = sprintf "%dd %02d:%02d:%02d",
		614	(int $m->[8] / 86400),
		615	(int $m->[8] / 3600) % 24,
		616	(int $m->[8] / 60) % 60,
		617	$m->[8] % 60;
		618
		619	$m = [$users, $host, $uptime, $version, $desc];
		620
		621	$y++;
		622
		623	$table->add (0, $y, new CFClient::UI::VBox children => [
		624	(new CFClient::UI::Button text => "Use", connect_activate => sub {
		625	$HOST->set_text ($CFG->{host} = $host);
		626	}),
		627	(new CFClient::UI::Empty expand => 1),
		628	]);
		629
		630	$table->add ($_ + 1, $y, new CFClient::UI::Label align => $align[$_], text => $m->[$_], fontsize => 0.8)
		631	for 0 .. $#$m;
228	}	632	}
		633	}
		634	});
		635	}
		636
		637	sub server_setup {
		638	my $dialog = new CFClient::UI::FancyFrame
		639	title => "Server Setup",
		640	child => (my $vbox = new CFClient::UI::VBox);
		641
		642	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
		643	$table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
		644
		645	{
		646	$table->add (1, 2, my $vbox = new CFClient::UI::VBox);
		647
		648	$vbox->add (
		649	my $HOST = new CFClient::UI::Entry
		650	expand => 1,
		651	text => $CFG->{host},
		652	tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
		653	connect_changed => sub {
		654	my ($self, $value) = @_;
		655	$CFG->{host} = $value;
229		656	}
230	my $interval = ($NOW - $last_refresh) * 0.001;	657	);
231	$last_refresh = $NOW;
232		658
233	if ($interval) {	659	$METASERVER = metaserver_dialog;
234	$FPS ||= 1 / $interval;	660
235	$FPS = $FPS * 0.9 + (1 / $interval) * 0.1;	661	$vbox->add (new CFClient::UI::Flopper
236	debug sprintf "%5.02f", $FPS;	662	expand => 1,
		663	text => "Metaserver",
		664	other => $METASERVER,
		665	tooltip => "Show a list of avaible crossfire servers",
		666	connect_open => sub {
		667	update_metaserver $HOST;
237	}	668	}
		669	);
		670	}
238		671
239	force_refresh;	672	$table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
240	$_->animate ($interval) for grep $_, values %ANIMATE;	673	$table->add (1, 4, new CFClient::UI::Entry
		674	text => $CFG->{user},
		675	tooltip => "The name of your character on the server",
		676	connect_changed => sub {
		677	my ($self, $value) = @_;
		678	$CFG->{user} = $value;
		679	}
		680	);
241		681
242	if (%ANIMATE) {	682	$table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
		683	$table->add (1, 5, new CFClient::UI::Entry
		684	text => $CFG->{password},
		685	hidden => 1,
		686	tooltip => "The password for your character",
		687	connect_changed => sub {
		688	my ($self, $value) = @_;
		689	$CFG->{password} = $value;
		690	}
		691	);
		692
		693	$table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "Def. say cmd");
		694	$table->add (1, 6, my $saycmd = new CFClient::UI::Entry
		695	text => $CFG->{say_command},
		696	tooltip => "This is the command that will be used if you write a line in the message window entry. "
		697	."Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
		698	."But you could also set it to 'tell &lt;playername&gt;' to only chat with that user.",
		699	connect_changed => sub {
		700	my ($self, $value) = @_;
		701	$CFG->{say_command} = $value;
		702	}
		703	);
		704
		705	$table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
		706	$table->add (1, 7, new CFClient::UI::Slider
		707	req_w => 100,
		708	range => [$CFG->{mapsize}, 10, 100 + 1, 1],
		709	tooltip => "This is the size of the portion of the map update the server sends you. "
		710	."If you set this to a high value you will be able to see further for example.",
		711	connect_changed => sub {
		712	my ($self, $value) = @_;
		713
		714	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;
		715	},
		716	);
		717
		718	$table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Login", connect_activate => sub {
		719	start_game;
		720	});
		721
		722	$dialog
		723	}
		724
		725	sub message_window {
		726	my $window = new CFClient::UI::FancyFrame
		727	title => "Messages",
		728	border_bg => [1, 1, 1, 0.5],
		729	bg => [0.3, 0.3, 0.3, 0.8],
		730	user_w => int $::WIDTH / 3,
		731	user_h => int $::HEIGHT / 5,
		732	child => (my $vbox = new CFClient::UI::VBox);
		733
		734	$vbox->add ($LOGVIEW = new CFClient::UI::TextView
		735	expand => 1,
		736	font => $FONT_FIXED,
		737	fontsize => $::CFG->{log_fontsize},
		738	);
		739
		740	$vbox->add (my $input = new CFClient::UI::Entry
		741	connect_focus_in => sub {
		742	my ($input, $prev_focus) = @_;
		743
		744	delete $input->{refocus_map};
		745
		746	if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
		747	$input->{refocus_map} = 1;
243	1	748	}
		749	delete $input->{auto_activated};
		750	},
		751	connect_activate => sub {
		752	my ($input, $text) = @_;
		753	$input->set_text ('');
		754
		755	if ($text =~ /^\/(.*)/) {
		756	$::CONN->user_send ($1);
244	} else {	757	} else {
245	undef $refresh_handler;	758	my $say_cmd = $::CFG->{say_command} || 'say';
		759	$::CONN->user_send ("$say_cmd $text");
		760	}
		761	if ($input->{refocus_map}) {
		762	delete $input->{refocus_map};
		763	$MAPWIDGET->focus_in
		764	}
		765	},
		766	connect_escape => sub {
		767	$MAPWIDGET->focus_in
		768	},
		769	);
		770
		771	$CONSOLE = {
		772	window => $window,
		773	input => $input
		774	};
		775
		776	$window
		777	}
		778
		779	sub sdl_init {
		780	CFClient::SDL_Init
		781	and die "SDL::Init failed!\n";
		782	}
		783
		784	sub video_init {
		785	sdl_init;
		786
		787	($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
		788	$FULLSCREEN = $CFG->{fullscreen};
		789	$FAST = $CFG->{fast};
		790
		791	CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
		792	or die "SDL_SetVideoMode failed!\n";
		793
		794	$SDL_ACTIVE = 1;
		795
		796	$LAST_REFRESH = time - 0.01;
		797
		798	CFClient::gl_init;
		799
		800	$FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
		801
		802	#############################################################################
		803
		804	$DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100;
		805	$DEBUG_STATUS->show;
		806
		807	$STATUS_LINE = new CFClient::UI::Label
		808	padding => 0,
		809	y => $HEIGHT - $FONTSIZE * 1.8;
		810	$STATUS_LINE->show;
		811
		812	$ALT_ENTER_MESSAGE = new CFClient::UI::Label
		813	padding => 0,
		814	fontsize => 0.8,
		815	markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode";
		816	$ALT_ENTER_MESSAGE->show;
		817	$ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h});
		818
		819	$CFClient::UI::ROOT->add ($MAPWIDGET = new CFClient::MapWidget);
		820	$MAPWIDGET->focus_in;
		821	$MAPWIDGET->connect (activate_console => sub {
		822	my ($mapwidget, $preset) = @_;
		823
		824	if ($CONSOLE) {
		825	$CONSOLE->{input}->{auto_activated} = 1;
		826	$CONSOLE->{input}->focus_in;
		827
		828	if ($preset && $CONSOLE->{input}->get_text eq '') {
		829	$CONSOLE->{input}->set_text ($preset);
		830	}
		831	}
		832	});
		833
		834	$CFClient::UI::ROOT->add ($BUTTONBAR = new CFClient::UI::HBox);
		835
		836	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup);
		837	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup);
		838	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);
		839
		840	$CFClient::UI::ROOT->add (make_gauge_window); # 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
		841	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window);
		842
		843	$BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {
		844	CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
		845	status "Configuration Saved";
		846	});
		847
		848	$BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
		849	}
		850
		851	sub video_shutdown {
		852	$CFClient::UI::ROOT->{children} = [];
		853	undef $CFClient::UI::GRAB;
		854	undef $CFClient::UI::HOVER;
		855	undef $SDL_ACTIVE;
		856	}
		857
		858	my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
		859	my $bgmusic;#TODO#hack#d#
		860
		861	sub audio_music_finished {
		862	return unless $CFG->{bgm_enable};
		863
		864	# TODO: hack, do play loop and mood music
		865	$bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/$bgmusic[0]";
		866	$bgmusic->play (0);
		867
		868	push @bgmusic, shift @bgmusic;
		869	}
		870
		871	sub audio_init {
		872	if ($CFG->{audio_enable}) {
		873	if (open my $fh, "<:utf8", CFClient::find_rcfile "sounds/config") {
		874	$SDL_MIXER = !CFClient::Mix_OpenAudio;
		875	CFClient::Mix_AllocateChannels 8;
		876	CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
		877
		878	audio_music_finished;
		879
		880	while (<$fh>) {
		881	next if /^\s*#/;
		882	next if /^\s*$/;
		883
		884	my ($file, $volume, $event) = split /\s+/, $_, 3;
		885
		886	push @SOUNDS, "$volume,$file";
		887
		888	$AUDIO_CHUNKS{"$volume,$file"} ||= do {
		889	my $chunk = new_from_file CFClient::MixChunk CFClient::find_rcfile "sounds/$file";
		890	$chunk->volume ($volume * 128 / 100);
		891	$chunk
246	0	892	};
247	}	893	}
248	} else {	894	} else {
249	undef $refresh_handler;	895	status "unable to open sound config: $!";
250	0
251	}	896	}
252	};	897	}
		898	}
		899
		900	sub audio_shutdown {
		901	CFClient::Mix_CloseAudio if $SDL_MIXER;
		902	undef $SDL_MIXER;
		903	@SOUNDS = ();
		904	%AUDIO_CHUNKS = ();
		905	}
		906
		907	my %animate_object;
		908	my $animate_timer;
		909
		910	my $want_refresh;
		911	my $can_refresh;
		912
		913	my $fps = 9;
		914
		915	sub force_refresh {
		916	$fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05;
		917	debug sprintf "%3.2f", $fps;
		918
		919	$want_refresh = 0;
		920	$can_refresh = 0;
		921
		922	$CFClient::UI::ROOT->draw;
		923
		924	CFClient::SDL_GL_SwapBuffers;
		925
		926	$LAST_REFRESH = $NOW;
		927	}
		928
		929	my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {
		930	$NOW = time;
		931
		932	($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
		933	for CFClient::SDL_PollEvent;
		934
		935	if (%animate_object) {
		936	$_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
		937	$want_refresh++;
		938	}
		939
		940	if ($want_refresh) {
		941	force_refresh;
		942	} else {
		943	$can_refresh = 1;
		944	}
		945	});
		946
		947	sub refresh {
		948	$want_refresh++;
253	}	949	}
254		950
255	sub animation_start {	951	sub animation_start {
256	my ($widget) = @_;	952	my ($widget) = @_;
257	$ANIMATE{$widget} = $widget;	953	$animate_object{$widget} = $widget;
258	Scalar::Util::weaken $ANIMATE{$widget};
259
260	refresh;
261	}	954	}
262		955
263	sub animation_stop {	956	sub animation_stop {
264	my ($widget) = @_;	957	my ($widget) = @_;
265	delete $ANIMATE{$widget};	958	delete $animate_object{$widget};
		959	}
		960
		961	@conn::ISA = Crossfire::Protocol::;
		962
		963	sub conn::stats_update {
		964	my ($self, $stats) = @_;
		965
		966	update_stats_window ($stats);
		967	}
		968
		969	sub conn::user_send {
		970	my ($self, $command) = @_;
		971
		972	$self->send_command ($command);
		973	status $command;
		974	}
		975
		976	sub conn::map_scroll {
		977	my ($self, $dx, $dy) = @_;
		978
		979	$MAP->scroll ($dx, $dy);
		980	}
		981
		982	sub conn::feed_map1a {
		983	my ($self, $data) = @_;
		984
		985	# $self->Crossfire::Protocol::feed_map1a ($data);
		986
		987	$MAP->map1a_update ($data);
		988	$MAPWIDGET->update;
		989	}
		990
		991	sub conn::flush_map {
		992	my ($self) = @_;
		993
		994	my $map_info = delete $self->{map_info}
		995	or return;
		996
		997	my ($hash, $x, $y, $w, $h) = @$map_info;
		998
		999	my $data = $MAP->get_rect ($x, $y, $w, $h);
		1000	$MAPCACHE->put ($hash => Compress::LZF::compress $data);
		1001	#warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
		1002	}
		1003
		1004	sub conn::map_clear {
		1005	my ($self) = @_;
		1006
		1007	$self->flush_map;
		1008	delete $self->{neigh_map};
		1009
		1010	$MAP->clear;
		1011	}
		1012
		1013
		1014	sub conn::load_map($$$) {
		1015	my ($self, $hash, $x, $y) = @_;
		1016
		1017	if (defined (my $data = $MAPCACHE->get ($hash))) {
		1018	$data = Compress::LZF::decompress $data;
		1019	#warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
		1020	for my $id ($MAP->set_rect ($x, $y, $data)) {
		1021	my $data = $TILECACHE->get ($id)
		1022	or next;
		1023
		1024	$self->set_texture ($id => $data);
		1025	}
		1026	}
		1027	}
		1028
		1029	# this method does a "flood fill" into every tile direction
		1030	# it assumes that tiles are arranged in a rectangular grid,
		1031	# i.e. a map is the same as the left of the right map etc.
		1032	# failure to comply are harmless and result in display errors
		1033	# at worst.
		1034	sub conn::flood_fill {
		1035	my ($self, $gx, $gy, $path, $hash, $flags) = @_;
		1036
		1037	# the server does not allow map paths > 6
		1038	return if 6 <= length $path;
		1039
		1040	my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
		1041
		1042	for (
		1043	[1, 0, -1],
		1044	[2, 1, 0],
		1045	[3, 0, 1],
		1046	[4, -1, 0],
		1047	) {
		1048	my ($tile, $dx, $dy) = @$_;
		1049
		1050	my $gx = $gx + $dx;
		1051	my $gy = $gy + $dy;
		1052
		1053	next unless $flags & (1 << ($tile - 1));
		1054	next if $self->{neigh_grid}{$gx, $gy}++;
		1055
		1056	my $neigh = $self->{neigh_map}{$hash} ||= [];
		1057	if (my $info = $neigh->[$tile]) {
		1058	my ($flags, $x, $y, $w, $h, $hash) = @$info;
		1059
		1060	$self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags)
		1061	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
		1062
		1063	} else {
		1064	$self->send_mapinfo ("spatial $path$tile", sub {
		1065	my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
		1066
		1067	return if $mode ne "spatial";
		1068
		1069	$x += $MAP->ox;
		1070	$y += $MAP->oy;
		1071
		1072	$self->load_map ($hash, $x, $y)
		1073	unless $self->{neigh_map}{$hash}[5]++;#d#
		1074
		1075	$neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
		1076
		1077	$self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags)
		1078	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
		1079	});
		1080	}
		1081	}
		1082	}
		1083
		1084	sub conn::map_change {
		1085	my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
		1086
		1087	$self->flush_map;
		1088
		1089	my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
		1090
		1091	my $mapmapw = 250;
		1092	my $mapmaph = 250;
		1093
		1094	$self->{neigh_rect} = [
		1095	$ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
		1096	$ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
		1097	];
		1098
		1099	delete $self->{neigh_grid};
		1100	$self->flood_fill (0, 0, "", $hash, $flags);
		1101
		1102	$x += $ox;
		1103	$y += $oy;
		1104
		1105	$self->{map_info} = [$hash, $x, $y, $w, $h];
		1106
		1107	my $map = $self->{map_info}[0];
		1108	$map =~ s/^.*?\/([^\/]+)$/\1/;
		1109	$STATWIDS->{map}->set_text ("Map: " . $map);
		1110
		1111	$self->load_map ($hash, $x, $y);
		1112	}
		1113
		1114	sub conn::face_find {
		1115	my ($self, $facenum, $face) = @_;
		1116
		1117	my $hash = "$face->{chksum},$face->{name}";
		1118
		1119	my $id = $FACEMAP->get ($hash);
		1120
		1121	unless ($id) {
		1122	# create new id for face
		1123	# i love transactions
		1124	for (1..100) {
		1125	my $txn = $CFClient::DB_ENV->txn_begin;
		1126	my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);
		1127	if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
		1128	$id++;
		1129	if ($FACEMAP->put (id => $id) == 0
		1130	&& $FACEMAP->put ($hash => $id) == 0) {
		1131	$txn->txn_commit;
		1132
		1133	goto gotid;
		1134	}
		1135	}
		1136	$txn->abort;
		1137	}
		1138
		1139	CFClient::fatal "maximum number of transaction retries reached - database problems?";
		1140	}
		1141
		1142	gotid:
		1143	$face->{id} = $id;
		1144	$MAP->set_face ($facenum => $id);
		1145	$self->{faceid}[$facenum] = $id;#d#
		1146	$TILECACHE->get ($id)
		1147	}
		1148
		1149	sub conn::face_update {
		1150	my ($self, $facenum, $face) = @_;
		1151
		1152	$TILECACHE->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes
		1153
		1154	$self->set_texture ($face->{id} => delete $face->{image});
		1155	}
		1156
		1157	sub conn::set_texture {
		1158	my ($self, $id, $data) = @_;
		1159
		1160	$self->{texture}[$id] ||= do {
		1161	my $tex =
		1162	new_from_image CFClient::Texture
		1163	$data, minify => 1, mipmap => 1;
		1164
		1165	$MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
		1166	$MAPWIDGET->update;
		1167
		1168	$tex
		1169	};
		1170	}
		1171
		1172	sub conn::sound_play {
		1173	my ($self, $x, $y, $soundnum, $type) = @_;
		1174
		1175	$SDL_MIXER
		1176	or return;
		1177
		1178	my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
		1179	or return;
		1180
		1181	$chunk->play;
		1182	# warn "sound $x,$y,$soundnum,$type\n";#d#
		1183	}
		1184
		1185	my $LAST_QUERY; # server is stupid, stupid, stupid
		1186
		1187	sub conn::query {
		1188	my ($self, $flags, $prompt) = @_;
		1189
		1190	$prompt = $LAST_QUERY unless length $prompt;
		1191	$LAST_QUERY = $prompt;
		1192
		1193	my $dialog = new CFClient::UI::FancyFrame
		1194	title => "Query",
		1195	child => my $vbox = new CFClient::UI::VBox;
		1196
		1197	$vbox->add (new CFClient::UI::Label
		1198	max_w => $::WIDTH * 0.4,
		1199	text => $prompt);
		1200
		1201	if ($flags & Crossfire::Protocol::CS_QUERY_YESNO) {
		1202	$vbox->add (my $hbox = new CFClient::HBox);
		1203	$hbox->add (new CFClient::Button
		1204	text => "No",
		1205	connect_activate => sub {
		1206	$self->send ("reply n");
		1207	$dialog->destroy;
		1208	$MAPWIDGET->focus_in;
		1209	}
		1210	);
		1211	$hbox->add (new CFClient::Button
		1212	text => "Yes",
		1213	connect_activate => sub {
		1214	$self->send ("reply y");
		1215	$dialog->destroy;
		1216	$MAPWIDGET->focus_in;
		1217	},
		1218	);
		1219
		1220	$dialog->focus_in;
		1221
		1222	} elsif ($flags & Crossfire::Protocol::CS_QUERY_SINGLECHAR) {
		1223	$dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";
		1224	$vbox->add (my $entry = new CFClient::UI::Entry
		1225	connect_changed => sub {
		1226	$self->send ("reply $_[1]");
		1227	$dialog->destroy;
		1228	$MAPWIDGET->focus_in;
		1229	},
		1230	);
		1231
		1232	$entry->focus_in;
		1233
		1234	} else {
		1235	$dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
		1236
		1237	$vbox->add (my $entry = new CFClient::UI::Entry
		1238	$flags & Crossfire::Protocol::CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (),
		1239	connect_activate => sub {
		1240	$self->send ("reply $_[1]");
		1241	$dialog->destroy;
		1242	$MAPWIDGET->focus_in;
		1243	},
		1244	);
		1245
		1246	$entry->focus_in;
		1247	}
		1248
		1249	$dialog->show;
		1250	}
		1251
		1252	sub conn::drawinfo {
		1253	my ($self, $color, $text) = @_;
		1254
		1255	my @color = (
		1256	[1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
		1257	[1.00, 1.00, 1.00],
		1258	[0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]
		1259	[1.00, 0.00, 0.00],
		1260	[1.00, 0.54, 0.00],
		1261	[0.11, 0.56, 1.00],
		1262	[0.93, 0.46, 0.00],
		1263	[0.18, 0.54, 0.34],
		1264	[0.56, 0.73, 0.56],
		1265	[0.80, 0.80, 0.80],
		1266	[0.55, 0.41, 0.13],
		1267	[0.99, 0.77, 0.26],
		1268	[0.74, 0.65, 0.41],
		1269	);
		1270
		1271	$LOGVIEW->add_paragraph ($color[$color], $text);
		1272	}
		1273
		1274	sub conn::spell_add {
		1275	my ($self, $spell) = @_;
		1276
		1277	# TODO
		1278	# create a widget dynamically, using spell face (CF::Protocol downloads them)
		1279	$MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message});
		1280	$MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message});
		1281	}
		1282
		1283	sub conn::spell_delete {
		1284	my ($self, $spell) = @_;
		1285	}
		1286
		1287	sub conn::addme_success {
		1288	my ($self) = @_;
		1289
		1290	for my $skill (values %{$self->{skill_info}}) {
		1291	$MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'");
		1292	$MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'");
		1293	}
		1294	}
		1295
		1296	sub update_floorbox {
		1297	$CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
		1298	$FLOORBOX->clear;
		1299	$FLOORBOX->add (new CFClient::UI::Empty expand => 1);
		1300
		1301	my @items = values %{ $CONN->{container}{0} };
		1302
		1303	# we basically have to use the same sorting as everybody else
		1304	@items = sort { $a->{type} <=> $b->{type} } @items;
		1305
		1306	for my $item (reverse @items) {
		1307	my $desc = $item->{nrof} < 2
		1308	? $item->{name}
		1309	: "$item->{nrof} $item->{name_pl}";
		1310	# todo: animation widget, face widget, weight(?) etc.
		1311	$FLOORBOX->add (my $hbox = new CFClient::UI::HBox
		1312	tooltip => (CFClient::UI::Label->escape ($desc)
		1313	. "\n<small>leftclick - pick up\nmiddle click - apply\nrightclick - menu</small>"),
		1314	can_hover => 1,
		1315	can_events => 1,
		1316	connect_button_down => sub {
		1317	my ($self, $ev, $x, $y) = @_;
		1318
		1319	# todo: maybe put examine on 1? but should just be a tooltip :(
		1320	if ($ev->{button} == 1) {
		1321	$CONN->send ("move $CONN->{player}{tag} $item->{tag} 0");
		1322	} elsif ($ev->{button} == 2) {
		1323	$CONN->send ("apply $item->{tag}");
		1324	} elsif ($ev->{button} == 3) {
		1325	# examine, lock, mark, maybe other things
		1326	warn "MENU not implemented yet\n";
		1327	}
		1328
		1329	1
		1330	},
		1331	);
		1332
		1333	$hbox->add (new CFClient::UI::Face
		1334	can_events => 0,
		1335	face => $item->{face},
		1336	anim => $item->{anim},
		1337	animspeed => $item->{animspeed},
		1338	);
		1339
		1340	$hbox->add (new CFClient::UI::Label
		1341	can_events => 0,
		1342	text => $desc,
		1343	);
		1344	}
		1345	});
		1346	refresh;
		1347	}
		1348
		1349	sub conn::container_add {
		1350	my ($self, $id, $items) = @_;
		1351
		1352	update_floorbox if $id == 0;
		1353	# $self-<{player}{tag} => player inv
		1354	#use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
		1355	}
		1356
		1357	sub conn::container_clear {
		1358	my ($self, $id) = @_;
		1359
		1360	update_floorbox if $id == 0;
		1361	# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
		1362	}
		1363
		1364	sub conn::item_delete {
		1365	my ($self, @items) = @_;
		1366
		1367	for (@items) {
		1368	update_floorbox if $_->{container} == 0;
		1369	}
		1370	}
		1371
		1372	sub conn::item_update {
		1373	my ($self, $item) = @_;
		1374
		1375	update_floorbox if $item->{container} == 0;
266	}	1376	}
267		1377
268	%SDL_CB = (	1378	%SDL_CB = (
269	SDL_QUIT() => sub {	1379	CFClient::SDL_QUIT => sub {
270	main_quit Gtk2;	1380	Event::unloop -1;
271	},	1381	},
272	SDL_VIDEORESIZE() => sub {	1382	CFClient::SDL_VIDEORESIZE => sub {
273	},	1383	},
274	SDL_VIDEOEXPOSE() => sub {	1384	CFClient::SDL_VIDEOEXPOSE => \&refresh,
275	refresh;
276	},
277	SDL_KEYDOWN() => sub {
278	if ($SDL_EV->key_mod & KMOD_ALT && $SDL_EV->key_sym == SDLK_RETURN) {
279	# alt-enter
280	$FULLSCREEN = !$FULLSCREEN;
281	init_screen;
282	} else {
283	CFClient::UI::feed_sdl_key_down_event ($SDL_EV);
284	}
285	},
286	SDL_KEYUP() => sub {
287	CFClient::UI::feed_sdl_key_up_event ($SDL_EV);
288	},
289	SDL_MOUSEMOTION() => sub {
290	CFClient::UI::feed_sdl_motion_event ($SDL_EV);
291	},
292	SDL_MOUSEBUTTONDOWN() => sub {
293	CFClient::UI::feed_sdl_button_down_event ($SDL_EV);
294	},
295	SDL_MOUSEBUTTONUP() => sub {
296	CFClient::UI::feed_sdl_button_up_event ($SDL_EV);
297	},
298	SDL_ACTIVEEVENT() => sub {	1385	CFClient::SDL_ACTIVEEVENT => sub {
299	# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#	1386	# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
300	},	1387	},
		1388	CFClient::SDL_KEYDOWN => sub {
		1389	if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
		1390	# alt-enter
		1391	video_shutdown;
		1392	$CFG->{fullscreen} = !$CFG->{fullscreen};
		1393	video_init;
		1394	} else {
		1395	CFClient::UI::feed_sdl_key_down_event ($_[0]);
		1396	}
		1397	},
		1398	CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
		1399	CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
		1400	CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
		1401	CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
		1402	CFClient::SDL_USEREVENT => \&audio_music_finished,
301	);	1403	);
302		1404
303	@conn::ISA = Crossfire::Protocol::;
304
305	sub conn::map_update {
306	my ($self, $dirty) = @_;
307
308	$MAPWIDGET->update;
309	}
310
311	sub conn::map_scroll {
312	my ($self, $dx, $dy) = @_;
313
314	# refresh;
315	}
316
317	sub conn::map_clear {
318	my ($self) = @_;
319
320	# refresh;
321	}
322
323	sub conn::face_find {
324	my ($self, $face) = @_;
325
326	$FACECACHE->{"$face->{chksum},$face->{name}"}
327	}
328
329	sub conn::face_update {
330	my ($self, $face) = @_;
331
332	$FACECACHE->{"$face->{chksum},$face->{name}"} = $face->{image};
333
334	$face->{texture} = new_from_image CFClient::Texture delete $face->{image};
335	}
336
337	sub conn::query {
338	my ($self, $flags, $prompt) = @_;
339
340	warn "<<<<QUERY:$flags:$prompt>>>\n";#d#
341	}
342
343	sub gtk_add_cfg_field {
344	my ($tbl, $cfg, $klbl, $key, $value) = @_;
345	my $i = $cfg->{_i}++;
346	$tbl->attach_defaults (my $lbl = Gtk2::Label->new ($klbl), 0, 1, $i, $i + 1);
347	$tbl->attach_defaults (my $ent = Gtk2::Entry->new, 1, 2, $i, $i + 1);
348	if ($key eq 'password') {
349	$ent->set_invisible_char ("*");
350	$ent->set (visibility => 0)
351	}
352	$ent->set_text ($value);
353	$ent->signal_connect (changed => sub {
354	my ($ent) = @_;
355	$cfg->{$key} = $ent->get_text;
356	# TODO: Mapsize should be a slider in the game gui
357	if ($key eq 'mapsize' and $cfg->{$key} > 100) {
358	$cfg->{$key} = 100;
359	} elsif ($key eq 'mapsize' and $cfg->{$key} < 50) {
360	$cfg->{$key} = 50;
361	}
362	});
363	}
364
365	sub run_config_dialog {
366	my (%events) = @_;
367
368	my $w = Gtk2::Window->new;
369
370	my @cfg = (
371	[qw/Host host/],
372	[qw/Port port/],
373	[qw/Mapsize% mapsize/],
374	[qw/Username user/],
375	[qw/Password password/],
376	);
377
378	my $cfg = {};
379
380	$w->add (my $vb = Gtk2::VBox->new);
381	$vb->pack_start (my $t = Gtk2::Table->new (2, scalar @cfg), 0, 0, 0);
382	my $selmode = $::CFG->{width} . 'x' . $::CFG->{height};
383	$t->attach_defaults (Gtk2::Label->new ("Modes"), 0, 1, 0, 1);
384	$t->attach_defaults (my $cb = Gtk2::ComboBox->new_text, 1, 2, 0, 1);
385	my $i = 0;
386	my $act = 0;
387	for (map { "$_->[0]x$_->[1]" } @SDL_MODES) {
388	if ($_ eq $selmode) { $act = $i }
389	$cb->append_text ($_);
390	$i++;
391	}
392	$cb->set_active ($act);
393	$cb->signal_connect (changed => sub {
394	my ($cb) = @_;
395	my $txt = $cb->get_active_text;
396	if ($txt =~ m/(\d+)x(\d+)/) {
397	$::CFG->{width} = $1;
398	$::CFG->{height} = $2;
399	}
400	});
401
402	$cfg->{_i} = 1;
403	for (@cfg) {
404	gtk_add_cfg_field ($t, $cfg, $_->[0], $_->[1], $::CFG->{$_->[1]});
405	}
406
407	$vb->pack_start (my $hb = Gtk2::HBox->new, 0, 0, 0);
408	$hb->pack_start (my $cb = Gtk2::Button->new ("save"), 1, 1, 5);
409	$cb->signal_connect (clicked => sub {
410	for (keys %$cfg) {
411	$::CFG->{$_} = $cfg->{$_}
412	if $_ ne '_i';
413	}
414	CFClient::write_cfg "$CFrossfire::VARDIR/pclientrc";
415	});
416	$hb->pack_start (my $cb = Gtk2::Button->new ("login"), 1, 1, 5);
417	$cb->signal_connect (clicked => sub {
418	for (keys %$cfg) {
419	$::CFG->{$_} = $cfg->{$_}
420	if $_ ne '_i';
421	}
422	my $cb = $events{login} || sub {};
423	$cb->($::CFG->{user}, $::CFG->{password});
424	});
425	$hb->pack_start (my $cb = Gtk2::Button->new ("logout"), 1, 1, 5);
426	$cb->signal_connect (clicked => sub {
427	my $cb = $events{logout} || sub {};
428	$cb->();
429	});
430	$hb->pack_start (my $cb = Gtk2::Button->new ("quit"), 1, 1, 5);
431	$cb->signal_connect (clicked => sub { $w->destroy });
432
433	$w->show_all;
434
435	$w->signal_connect (destroy => sub { Gtk2->main_quit });
436	}
437
438
439	#############################################################################	1405	#############################################################################
440		1406
441	SDL::Init SDL_INIT_EVERYTHING;	1407	$SIG{INT} = $SIG{TERM} = sub { exit };
442		1408
443	@SDL_MODES = reverse map [SDL::RectW ($_), SDL::RectH ($_)],	1409	$TILECACHE = CFClient::db_table "tilecache";
444	@{ SDL::ListModes 0, SDL_FULLSCREEN|SDL_HWSURFACE };	1410	$FACEMAP = CFClient::db_table "facemap";
445		1411
446	CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";	1412	CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
447		1413
448	$CFG ||= {	1414	my %DEF_CFG = (
		1415	sdl_mode => 0,
449	width => 640,	1416	width => 640,
450	height => 480,	1417	height => 480,
		1418	fullscreen => 0,
		1419	fast => 0,
		1420	map_scale => 0.5,
		1421	fow_enable => 1,
		1422	fow_intensity => 0.45,
		1423	fow_smooth => 0,
		1424	gui_fontsize => 1,
		1425	log_fontsize => 1,
		1426	gauge_fontsize => 1,
		1427	gauge_size => 0.35,
		1428	stat_fontsize => 1,
451	mapsize => 100,	1429	mapsize => 100,
452	fullscreen => 0,
453	host => "crossfire.schmorp.de",	1430	host => "crossfire.schmorp.de",
454	port => 13327,	1431	say_command => 'say',
455	};	1432	audio_enable => 1,
		1433	bgm_enable => 1,
		1434	bgm_volume => 0.25,
		1435	);
		1436
		1437	while (my ($k, $v) = each %DEF_CFG) {
		1438	$CFG->{$k} = $v unless exists $CFG->{$k};
		1439	}
		1440
		1441	sdl_init;
		1442
		1443	@SDL_MODES = reverse
		1444	grep $_->[0] >= 640 && $_->[1] >= 480,
		1445	CFClient::SDL_ListModes;
		1446
		1447	@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
		1448
		1449	$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
456		1450
457	{	1451	{
458	my @fonts = map CFClient::find_rcfile $_, qw(uifont.ttf uifontb.ttf uifonti.ttf uifontbi.ttf);	1452	my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
		1453	DejaVuSans.ttf
		1454	DejaVuSansMono.ttf
		1455	DejaVuSans-Bold.ttf
		1456	DejaVuSansMono-Bold.ttf
		1457	DejaVuSans-Oblique.ttf
		1458	DejaVuSansMono-Oblique.ttf
		1459	DejaVuSans-BoldOblique.ttf
		1460	DejaVuSansMono-BoldOblique.ttf
		1461	);
459		1462
460	CFClient::add_font $_ for @fonts;	1463	CFClient::add_font $_ for @fonts;
461	CFClient::set_font $fonts[0];	1464
462	}	1465	$FONT_PROP = new_from_file CFClient::Font $fonts[0];
		1466	$FONT_FIXED = new_from_file CFClient::Font $fonts[1];
463		1467
464	$FACECACHE = eval { Crossfire::load_ref "$Crossfire::VARDIR/pclient.faces" } || {};	1468	$FONT_PROP->make_default;
		1469	}
465		1470
466	run_config_dialog	1471	video_init;
467	login => sub { start_game },	1472	audio_init;
468	logout => sub { stop_game };
469		1473
470	main Gtk2;	1474	Event::loop;
471		1475
472	Crossfire::save_ref $FACECACHE, "$Crossfire::VARDIR/pclient.faces";	1476	END { CFClient::SDL_Quit }
		1477
		1478	=head1 pclient - Crossfire+ and Crossfire game client
		1479
		1480	Pclient is a Crossfire+ and Crossfire game client.
		1481
		1482	=head2 Features
		1483
		1484	=over 4
		1485
		1486	=item Fullscreen Map
		1487
		1488	PClient can uses a fullscreen map, which greatly enhances how much of the
		1489	game world you can see.
		1490
		1491	=item Persistent Map Cache (Crossfire+ only)
		1492
		1493	PClient can persistently cache all map data it received from the
		1494	server. This not only allows it to display an overview map, but also
		1495	ensures that once-explored areas will be available the next time you want
		1496	to explore more.
		1497
		1498	=item Hardware acceleration
		1499
		1500	Unlike most Crossfire clients, PClient take advantage of OpenGL hardware
		1501	acceleration. Most modern graphics cards have difficulties with 2D
		1502	acceleration, while 3D graphics is accelerated well.
		1503
		1504	=item No arbitrary limits
		1505
		1506	Unlike other Crossfire clients, pclient does not suffer from arbitrary
		1507	limits (like a fixed amount of face numbers). There are still limits, but
		1508	they are not arbitrarily low :)
		1509
		1510	=back
		1511
		1512	=head1 FAQ
		1513
		1514	=over 4
		1515
		1516	=item The client is very sluggish and slow, what can I do about this?
		1517
		1518	Most likely, you don't have accelerated OpenGL support. Try to find a
		1519	newer driver, or a driver from your hardware vendor, that features OpenGL
		1520	support.
		1521
		1522	If this is not an option, the following Setup options reduce the load and
		1523	will likely make the client playable with sofwtare rendering (it will
		1524	still be slow, though):
		1525
		1526	=over 4
		1527
		1528	=item B<Video Mode> should be set as low as possible (e.g. 640x480)
		1529
		1530	=item Enable B<Fast & Ugly> mode
		1531
		1532	=item Disable B<Fog of War>
		1533
		1534	=item Increase B<Map Scale>
		1535
		1536	=back
		1537
		1538	=back
		1539
		1540	=head1 AUTHOR
		1541
		1542	Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
		1543
		1544
		1545

Diff Legend

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