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.80 by root, Wed Apr 12 02:00:07 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	use Glib;	6	# do things only needed for single-binary version (par)
7	use Gtk2 -init;	7	BEGIN {
		8	if (%PAR::LibCache) {
		9	@INC = grep ref, @INC; # weed out all paths except pars loader refs
8		10
9	use SDL;	11	while (my ($filename, $zip) = each %PAR::LibCache) {
10	use SDL::App;	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
		29	use Time::HiRes 'time';
		30	use Pod::POM;
11	use SDL::Event;	31	use Event;
12	use SDL::Surface;
13	use SDL::OpenGL;
14	use SDL::OpenGL::Constants;
15		32
16	use Crossfire;	33	use Crossfire;
17	use Crossfire::Protocol;	34	use Crossfire::Protocol;
18		35
		36	use Compress::LZF;
		37
19	use CFClient;	38	use CFClient;
20	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#
21		48
22	our $VERSION = '0.1';	49	our $VERSION = '0.1';
23		50
24	my $MAX_FPS = 60;	51	my $MAX_FPS = 60;
25	my $TICKS_PER_FRAME = int 1000 / $MAX_FPS - 1; # min ticks per frame	52	my $MIN_FPS = 5; # unused as of yet
26		53
		54	our $META_SERVER = "crossfire.real-time.com:13326";
		55
		56	our $FACEMAP;
		57	our $TILECACHE;
27	our $FACECACHE;	58	our $MAPCACHE;
		59
		60	our $LAST_REFRESH;
		61	our $NOW;
28		62
29	our $CFG;	63	our $CFG;
30	our $CONN;	64	our $CONN;
31	our $FAST; # fast, low-quality mode	65	our $FAST; # fast, low-quality mode, possibly useful for software-rendering
		66
		67	our $WANT_REFRESH;
		68	our $CAN_REFRESH;
32		69
33	our @SDL_MODES;	70	our @SDL_MODES;
34	our $WIDTH;	71	our $WIDTH;
35	our $HEIGHT;	72	our $HEIGHT;
36	our $FULLSCREEN;	73	our $FULLSCREEN;
		74	our $FONTSIZE;
37		75
38	our $NOW;	76	our $FONT_PROP;
		77	our $FONT_FIXED;
39		78
		79	our $MAP;
		80	our $MAPMAP;
40	our $MAPWIDGET;	81	our $MAPWIDGET;
41	our $FONTSIZE;	82	our $BUTTONBAR;
		83	our $LOGVIEW;
		84	our $CONSOLE;
		85	our $METASERVER;
		86	our $LOGIN_BUTTON;
		87	our $QUIT_DIALOG;
42		88
		89	our $FLOORBOX;
		90	our $GAUGES;
		91	our $STATWIDS;
		92
43	our $SDL_TIMER;	93	our $SDL_ACTIVE;
44	our $SDL_APP;
45	our $SDL_EV;
46	our %SDL_CB;	94	our %SDL_CB;
47		95
		96	our $SDL_MIXER;
		97	our @SOUNDS; # event => file mapping
		98	our %AUDIO_CHUNKS; # audio files
		99
48	our $ALT_ENTER_MESSAGE;	100	our $ALT_ENTER_MESSAGE;
49	our $STATUS_LINE;	101	our $STATUSBOX;
50	our $DEBUG_STATUS;	102	our $DEBUG_STATUS;
51		103
52	my $last_refresh;	104	our $INVWIN;
53	my %ANIMATE;	105	our $INV;
54	my $refresh_handler;	106	our $INVR;
		107	our $INVR_LBL;
		108	our $OPENCONT;
55		109
56	our ($tw, $te); # Test widget #d#	110	sub status {
		111	$STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 20, fg => [1, 1, 0, 1]);
		112	}
57		113
58	sub init_screen {	114	sub debug {
59	$SDL_APP = new SDL::App	115	$DEBUG_STATUS->set_text ($_[0]);
60	-flags => SDL_ANYFORMAT | SDL_HWSURFACE,	116	my ($w, $h) = $DEBUG_STATUS->size_request;
61	-title => "Crossfire+ Client",	117	$DEBUG_STATUS->move ($WIDTH - $w, 0);
62	-width => $WIDTH,	118	}
63	-height => $HEIGHT,
64	-opengl => 1,
65	-red_size => 5,
66	-green_size => 5,
67	-blue_size => 5,
68	-alpha_size => 0,
69	-double_buffer => 1,
70	-fullscreen => $FULLSCREEN,
71	-resizeable => 0;
72		119
73	$SDL_EV = new SDL::Event;	120	sub start_game {
74	$SDL_EV->set_unicode (1);	121	status "logging in...";
75		122
76	$SDL_TIMER = add Glib::Timeout 1000 / $MAX_FPS, sub {	123	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
77	($SDL_CB{$SDL_EV->type} || sub { warn "unhandled event ", $SDL_EV->type })->()
78	while $SDL_EV->poll;
79		124
		125	$MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";
		126	$MAP = new CFClient::Map $mapsize, $mapsize;
		127
		128	my ($host, $port) = split /:/, $CFG->{host};
		129
		130	$CONN = eval {
		131	new conn
		132	host => $host,
		133	port => $port || 13327,
		134	user => $CFG->{user},
		135	pass => $CFG->{password},
		136	mapw => $mapsize,
		137	maph => $mapsize,
80	1	138	;
81	};	139	};
82		140
83	$last_refresh = SDL::GetTicks;	141	if ($CONN) {
		142	CFClient::lowdelay fileno $CONN->{fh};
84		143
85	CFClient::gl_init;	144	$LOGIN_BUTTON->set_text ("Logout");
		145	status "login successful";
86		146
87	$FONTSIZE = int $HEIGHT / 40;	147	$BUTTONBAR->{children}[1]->emit ("activate")
		148	if $BUTTONBAR->{children}[1]->{state};
88		149
89	#############################################################################	150	} else {
90		151	status "unable to connect";
91	$DEBUG_STATUS = new CFClient::UI::Label padding => 0;	152	stop_game();
92	$CFClient::UI::TOPLEVEL->add ($DEBUG_STATUS);
93		153	}
94	$STATUS_LINE = new CFClient::UI::Label
95	padding => 0,
96	y => $HEIGHT * 49 / 50 - $FONTSIZE;
97	$CFClient::UI::TOPLEVEL->add ($STATUS_LINE);
98
99	$ALT_ENTER_MESSAGE = new CFClient::UI::Label
100	padding => 0,
101	y => $HEIGHT * 49 / 50,
102	height => $HEIGHT / 50,
103	text => "Use <b>Alt-Enter</b> to toggle fullscreen mode";
104	$CFClient::UI::TOPLEVEL->add ($ALT_ENTER_MESSAGE);
105
106	$MAPWIDGET = new CFClient::UI::MapWidget;
107	$CFClient::UI::TOPLEVEL->add ($MAPWIDGET);
108	$MAPWIDGET->focus_in;
109	}	154	}
110		155
111	sub destroy_screen {	156	sub stop_game {
112	remove Glib::Source $SDL_TIMER;	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;
113	undef $SDL_APP;	168	undef $MAP;
114	undef $SDL_EV;
115	SDL::Quit;
116	}	169	}
117		170
118	sub config_dialog {	171	sub client_setup {
119	my $dialog = new CFClient::UI::FancyFrame x => 300, y => 100,	172	my $dialog = new CFClient::UI::FancyFrame
		173	title => "Client Setup",
120	child => (my $vbox = new CFClient::UI::VBox);	174	child => (my $vbox = new CFClient::UI::VBox);
121	$vbox->add (new CFClient::UI::Label align => 0, text => "Setup");
122	$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]);
123		176
124	$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");
125	$table->add (1, 0, my $hbox = new CFClient::UI::HBox);	178	$table->add (1, 0, my $hbox = new CFClient::UI::HBox);
126		179
127	$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]);
128	$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");
129		182
130	$mode_slider->connect (changed => sub {	183	$mode_slider->connect (changed => sub {
131	my ($self, $value) = @_;	184	my ($self, $value) = @_;
132		185
133	$CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;	186	$CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
134	$mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});	187	$mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});
135	});	188	});
136	$mode_slider->emit (changed => $mode_slider->{range}[0]);	189	$mode_slider->emit (changed => $mode_slider->{range}[0]);
137
138	$table->add (0, 1, new CFClient::UI::Label align => 1, text => "Host");
139	$table->add (1, 1, my $host = new CFClient::UI::Entry text => $CFG->{host});
140
141	$table->add (0, 2, new CFClient::UI::Label align => 1, text => "Port");
142	$table->add (1, 2, my $port = new CFClient::UI::Entry text => $CFG->{port});
143		190
		191	my $row = 1;
		192
144	$table->add (0, 3, new CFClient::UI::Label align => 1, text => "Username");	193	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
145	$table->add (1, 3, my $user = new CFClient::UI::Entry text => $CFG->{user});
146
147	$table->add (0, 4, new CFClient::UI::Label align => 1, text => "Password");
148	$table->add (1, 4, my $pass = new CFClient::UI::Entry text => $CFG->{password}, hidden => 1);
149
150	$table->add (0, 5, new CFClient::UI::Label align => 1, text => "Map Size");
151	$table->add (1, 5, new CFClient::UI::Slider	194	$table->add (1, $row++, new CFClient::UI::CheckBox
152	req_w => 100,	195	state => $CFG->{fullscreen},
153	range => [$CFG->{mapsize}, 10, 100 + 1, 1],	196	tooltip => "Bring the client into fullscreen mode",
154	connect_changed => sub {	197	connect_changed => sub {
155	my ($self, $value) = @_;	198	my ($self, $value) = @_;
		199	$CFG->{fullscreen} = $value;
		200	}
		201	);
		202
		203	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
		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 {
		208	my ($self, $value) = @_;
		209	$CFG->{fast} = $value;
		210	}
		211	);
		212
		213	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
		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 {
		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) = @_;
		229	$CFG->{fow_enable} = $value;
		230	}
		231	);
		232
		233	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
		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 {
		238	my ($self, $value) = @_;
		239	$CFG->{fow_intensity} = $value;
		240	}
		241	);
		242
		243	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
		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 {
		248	my ($self, $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];
		319	# });
		320	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");
		321	$table->add (1, $row++, my $hbox = new CFClient::UI::HBox);
		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 {
		354	my ($self, $value) = @_;
		355	$CFG->{say_command} = $value;
		356	}
		357	);
		358
		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
		599	}
		600
		601	sub metaserver_dialog {
		602	my $dialog = new CFClient::UI::FancyFrame
		603	title => "Server List",
		604	child => (my $vbox = new CFClient::UI::VBox);
		605
		606	$vbox->add ($dialog->{table} = new CFClient::UI::Table);
		607
		608	$dialog
		609	}
		610
		611	my $METASERVER_ATIME;
		612
		613	sub update_metaserver {
		614	my ($HOST) = @_;
		615
		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...");
		622
		623	my $buf;
		624
		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	}
		631
		632	Event->io (fd => $fh, poll => 'r', cb => sub {
		633	my $res = sysread $fh, $buf, 8192, length $buf;
		634
		635	if (!defined $res) {
		636	$_[0]->w->cancel;
		637	$label->set_text ("error while retrieving server list: $!");
		638	} elsif ($res == 0) {
		639	$_[0]->w->cancel;
		640	status "server list retrieved";
		641
		642	utf8::decode $buf if utf8::valid $buf;
		643
		644	$table->clear;
		645
		646	my @col = qw(Use #Users Host Uptime Version Description);
		647	$table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])
		648	for 0 .. $#col;
		649
		650	my @align = qw(1 0 1 1 -1);
		651
		652	my $y = 0;
		653	for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) {
		654	my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m;
		655
		656	for ($desc) {
		657	s/<br>/\n/gi;
		658	s/<li>/\n· /gi;
		659	s/<.*?>//sgi;
		660	s/&/&amp;/g;
		661	s/</&lt;/g;
		662	s/>/&gt;/g;
		663	}
		664
		665	$uptime = sprintf "%dd %02d:%02d:%02d",
		666	(int $m->[8] / 86400),
		667	(int $m->[8] / 3600) % 24,
		668	(int $m->[8] / 60) % 60,
		669	$m->[8] % 60;
		670
		671	$m = [$users, $host, $uptime, $version, $desc];
		672
		673	$y++;
		674
		675	$table->add (0, $y, new CFClient::UI::VBox children => [
		676	(new CFClient::UI::Button text => "Use", connect_activate => sub {
		677	$HOST->set_text ($CFG->{host} = $host);
		678	}),
		679	(new CFClient::UI::Empty expand => 1),
		680	]);
		681
		682	$table->add ($_ + 1, $y, new CFClient::UI::Label
		683	ellipsise => 0, align => $align[$_], text => $m->[$_], fontsize => 0.8)
		684	for 0 .. $#$m;
		685	}
		686	}
		687	});
		688	}
		689
		690	sub server_setup {
		691	my $dialog = new CFClient::UI::FancyFrame
		692	title => "Server Setup",
		693	child => (my $vbox = new CFClient::UI::VBox);
		694
		695	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
		696	$table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
		697
		698	{
		699	$table->add (1, 2, my $vbox = new CFClient::UI::VBox);
		700
		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 {
		730	my ($self, $value) = @_;
		731	$CFG->{user} = $value;
		732	}
		733	);
		734
		735	$table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
		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 {
		741	my ($self, $value) = @_;
		742	$CFG->{password} = $value;
		743	}
		744	);
		745
		746	$table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
		747	$table->add (1, 7, new CFClient::UI::Slider
		748	req_w => 100,
		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.",
		752	connect_changed => sub {
		753	my ($self, $value) = @_;
156		754
157	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;	755	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;
158	},	756	},
159	);	757	);
160		758
		759	$table->add (0, 8, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");
		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] },
		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	);
		782
		783	$dialog
		784	}
		785
		786	sub message_window {
		787	my $window = new CFClient::UI::FancyFrame
		788	title => "Messages",
		789	border_bg => [1, 1, 1, 1],
		790	bg => [0, 0, 0, 0.75],
		791	user_w => int $::WIDTH / 3,
		792	user_h => int $::HEIGHT / 5,
		793	child => (my $vbox = new CFClient::UI::VBox);
		794
		795	$vbox->add ($LOGVIEW);
		796
		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.",
		802	connect_focus_in => sub {
		803	my ($input, $prev_focus) = @_;
		804
		805	delete $input->{refocus_map};
		806
		807	if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) {
		808	$input->{refocus_map} = 1;
		809	}
		810	delete $input->{auto_activated};
		811	},
		812	connect_activate => sub {
		813	my ($input, $text) = @_;
		814	$input->set_text ('');
		815
		816	if ($text =~ /^\/(.*)/) {
		817	$::CONN->user_send ($1);
		818	} else {
		819	my $say_cmd = $::CFG->{say_command} || 'say';
		820	$::CONN->user_send ("$say_cmd $text");
		821	}
		822	if ($input->{refocus_map}) {
		823	delete $input->{refocus_map};
		824	$MAPWIDGET->focus_in
		825	}
		826	},
		827	connect_escape => sub {
		828	$MAPWIDGET->focus_in
		829	},
		830	);
		831
		832	$CONSOLE = {
		833	window => $window,
		834	input => $input
		835	};
		836
		837	$window
		838	}
		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
161	$vbox->add (my $hbox = new CFClient::UI::HBox);	895	$vbox->add (my $buttons = new CFClient::UI::HBox);
162	$hbox->add (new CFClient::UI::Button expand => 1, align => 0, text => "Save", connect_activate => sub {	896	$vbox->add (my $viewer = new CFClient::UI::TextView expand => 1, fontsize => 0.8);
163	warn "save\n";	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	);
164	});	917	}
165	$hbox->add (new CFClient::UI::Button expand => 1, align => 0, text => "Login", connect_activate => sub {	918
166	warn "login\n";	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
		924	sub sdl_init {
		925	CFClient::SDL_Init
		926	and die "SDL::Init failed!\n";
		927	}
		928
		929	sub video_init {
		930	sdl_init;
		931
		932	$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
		933
		934	($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
		935	$FULLSCREEN = $CFG->{fullscreen};
		936	$FAST = $CFG->{fast};
		937
		938	CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
		939	or die "SDL_SetVideoMode failed: " . (CFClient::SDL_GetError) . "\n";
		940
		941	$SDL_ACTIVE = 1;
		942	$LAST_REFRESH = time - 0.01;
		943
		944	CFClient::gl_init;
		945
		946	$FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
		947
		948	$CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
		949
		950	#############################################################################
		951
		952	unless ($DEBUG_STATUS) {
		953	# create the widgets
		954
		955	$DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100, req_x => -1;
		956	$DEBUG_STATUS->show;
		957
		958	$STATUSBOX = new CFClient::UI::Statusbox;
		959	$STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", pri => -100, color => [1, 1, 1, 0.8]);
		960
		961	(new CFClient::UI::Frame
		962	bg => [0, 0, 0, 0.4],
		963	req_y => -1,
		964	child => $STATUSBOX,
		965	)->show;
		966
		967	CFClient::UI::FancyFrame->new (
		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;
		976	$MAPWIDGET->connect (activate_console => sub {
		977	my ($mapwidget, $preset) = @_;
		978
		979	if ($CONSOLE) {
		980	$CONSOLE->{input}->{auto_activated} = 1;
		981	$CONSOLE->{input}->focus_in;
		982
		983	if ($preset && $CONSOLE->{input}->get_text eq '') {
		984	$CONSOLE->{input}->set_text ($preset);
		985	}
		986	}
167	});	987	});
168	$hbox->add (new CFClient::UI::Button expand => 1, align => 0, text => "Apply", connect_activate => sub {	988	$MAPWIDGET->show;
169	warn "apply\n";	989	$MAPWIDGET->focus_in;
		990
		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	;
		999
		1000	$BUTTONBAR = new CFClient::UI::HBox;
		1001
		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.");
		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.");
		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.");
		1008
		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 {
		1020	CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
		1021	status "Configuration Saved";
		1022	},
		1023	);
		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 {
		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
170	});	1049	});
171		1050	force_refresh ();
172	$CFClient::UI::TOPLEVEL->add ($dialog);
173	}
174
175	sub start_game {
176	$WIDTH = $CFG->{width};
177	$HEIGHT = $CFG->{height};
178	$FULLSCREEN = 0;
179
180	init_screen;
181
182	config_dialog;
183
184	my $mapsize = List::Util::min 64, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
185
186	$CONN = new conn
187	host => $CFG->{host},
188	port => $CFG->{port},
189	user => $CFG->{user},
190	pass => $CFG->{password},
191	mapw => $mapsize,
192	maph => $mapsize,
193	;	1051	}
194
195	CFClient::lowdelay fileno $CONN->{fh};
196	}	1052	}
197		1053
198	sub stop_game {	1054	sub video_shutdown {
199	remove Glib::Source $refresh_handler if $refresh_handler;	1055	undef $SDL_ACTIVE;
200	undef $refresh_handler;
201
202	undef $CONN;
203	destroy_screen;
204	}	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;
		1114	undef $SDL_MIXER;
		1115	@SOUNDS = ();
		1116	%AUDIO_CHUNKS = ();
		1117	}
		1118
		1119	my %animate_object;
		1120	my $animate_timer;
		1121
		1122	my $fps = 9;
		1123
		1124	my %demo;#d#
205		1125
206	sub force_refresh {	1126	sub force_refresh {
207	glViewport 0, 0, $WIDTH, $HEIGHT;	1127	$fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
		1128	debug sprintf "%3.2f", $fps;
		1129
		1130	$CFClient::UI::ROOT->draw;
		1131
		1132	$WANT_REFRESH = 0;
		1133	$CAN_REFRESH = 0;
		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;
208		1158
209	glMatrixMode GL_PROJECTION;	1159	glMatrixMode GL_PROJECTION;
210	glLoadIdentity;	1160	glLoadIdentity;
		1161	glFrustum -1 * ($::WIDTH / $::HEIGHT), 1 * ($::WIDTH / $::HEIGHT), 1, -1, 1, 10000;
211	glOrtho 0, $WIDTH, $HEIGHT, 0, -10000 , 10000;	1162	#glOrtho 0, $::WIDTH, 0, $::HEIGHT, -10000, 10000;
212	glMatrixMode GL_MODELVIEW;	1163	glMatrixMode GL_MODELVIEW;
213	glLoadIdentity;	1164	glLoadIdentity;
214		1165
215	glClear GL_COLOR_BUFFER_BIT;	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;
216		1173
217	$CFClient::UI::TOPLEVEL->draw;	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	}
218		1179
219	SDL::GLSwapBuffers;	1180	glPopMatrix;
220	}
221		1181
222	sub debug {	1182	glShadeModel GL_FLAT;
223	$DEBUG_STATUS->set_text ($_[0]);	1183	glDisable GL_DEPTH_TEST;
224	my ($w, $h) = $DEBUG_STATUS->size_request;	1184	glDisable GL_TEXTURE_2D;
225	$DEBUG_STATUS->size_allocate ($WIDTH - $w, 0, $w, $h);	1185	glDepthMask 0;
226	}
227		1186
228	my $FPS;	1187	$WANT_REFRESH++;
		1188	};
		1189
		1190	CFClient::SDL_GL_SwapBuffers;
		1191	}
229		1192
230	sub refresh {	1193	my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {
231	$refresh_handler ||= add Glib::Idle sub {	1194	$NOW = time;
232	if ($SDL_APP) {
233	$NOW = SDL::GetTicks;
234		1195
235	if ($NOW - $last_refresh < $TICKS_PER_FRAME) {	1196	($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
236	SDL::Delay $TICKS_PER_FRAME - ($NOW - $last_refresh);	1197	for CFClient::SDL_PollEvent;
237	$NOW = SDL::GetTicks;
238	}
239
240	my $interval = ($NOW - $last_refresh) * 0.001;
241	$last_refresh = $NOW;
242		1198
243	if ($interval) {	1199	if (%animate_object) {
244	$FPS ||= 1 / $interval;	1200	$_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
245	$FPS = $FPS * 0.9 + (1 / $interval) * 0.1;	1201	$WANT_REFRESH++;
246	debug sprintf "%5.02f", $FPS;	1202	}
247	}
248		1203
		1204	if ($WANT_REFRESH) {
249	force_refresh;	1205	force_refresh;
250	$_->animate ($interval) for grep $_, values %ANIMATE;
251
252	if (%ANIMATE) {
253	1
254	} else {
255	undef $refresh_handler;
256	0
257	}
258	} else {	1206	} else {
259	undef $refresh_handler;	1207	$CAN_REFRESH = 1;
260	0
261	}
262	};	1208	}
263	}	1209	});
264		1210
265	sub animation_start {	1211	sub animation_start {
266	my ($widget) = @_;	1212	my ($widget) = @_;
267	$ANIMATE{$widget} = $widget;	1213	$animate_object{$widget} = $widget;
268	Scalar::Util::weaken $ANIMATE{$widget};
269
270	refresh;
271	}	1214	}
272		1215
273	sub animation_stop {	1216	sub animation_stop {
274	my ($widget) = @_;	1217	my ($widget) = @_;
275	delete $ANIMATE{$widget};	1218	delete $animate_object{$widget};
		1219	}
		1220
		1221	@conn::ISA = Crossfire::Protocol::;
		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
		1269	sub conn::user_send {
		1270	my ($self, $command) = @_;
		1271
		1272	$self->send_command ($command);
		1273	status $command;
		1274	}
		1275
		1276	sub conn::map_scroll {
		1277	my ($self, $dx, $dy) = @_;
		1278
		1279	$MAP->scroll ($dx, $dy);
		1280	}
		1281
		1282	sub conn::feed_map1a {
		1283	my ($self, $data) = @_;
		1284
		1285	# $self->Crossfire::Protocol::feed_map1a ($data);
		1286
		1287	$MAP->map1a_update ($data);
		1288	$MAPWIDGET->update;
		1289	}
		1290
		1291	sub conn::flush_map {
		1292	my ($self) = @_;
		1293
		1294	my $map_info = delete $self->{map_info}
		1295	or return;
		1296
		1297	my ($hash, $x, $y, $w, $h) = @$map_info;
		1298
		1299	my $data = $MAP->get_rect ($x, $y, $w, $h);
		1300	$MAPCACHE->put ($hash => Compress::LZF::compress $data);
		1301	#warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
		1302	}
		1303
		1304	sub conn::map_clear {
		1305	my ($self) = @_;
		1306
		1307	$self->flush_map;
		1308	delete $self->{neigh_map};
		1309
		1310	$MAP->clear;
		1311	}
		1312
		1313
		1314	sub conn::load_map($$$) {
		1315	my ($self, $hash, $x, $y) = @_;
		1316
		1317	if (defined (my $data = $MAPCACHE->get ($hash))) {
		1318	$data = Compress::LZF::decompress $data;
		1319	#warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
		1320	for my $id ($MAP->set_rect ($x, $y, $data)) {
		1321	my $data = $TILECACHE->get ($id)
		1322	or next;
		1323
		1324	$self->set_texture ($id => $data);
		1325	}
		1326	}
		1327	}
		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.
		1367	sub conn::flood_fill {
		1368	my ($self, $block, $gx, $gy, $path, $hash, $flags) = @_;
		1369
		1370	# the server does not allow map paths > 6
		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
		1389	next unless $flags & (1 << ($tile - 1));
		1390	next if $self->{neigh_grid}{$gx, $gy}++;
		1391
		1392	my $neigh = $self->{neigh_map}{$hash} ||= [];
		1393	if (my $info = $neigh->[$tile]) {
		1394	my ($flags, $x, $y, $w, $h, $hash) = @$info;
		1395
		1396	$self->flood_fill ($block, $gx, $gy, "$path$tile", $hash, $flags)
		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	});
		1416	}
		1417	}
		1418	}
		1419
		1420	sub conn::map_change {
		1421	my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
		1422
		1423	$self->flush_map;
		1424
		1425	my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
		1426
		1427	my $mapmapw = $MAPMAP->{w};
		1428	my $mapmaph = $MAPMAP->{h};
		1429
		1430	$self->{neigh_rect} = [
		1431	$ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
		1432	$ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
		1433	];
		1434
		1435	delete $self->{neigh_grid};
		1436
		1437	$x += $ox;
		1438	$y += $oy;
		1439
		1440	$self->{map_info} = [$hash, $x, $y, $w, $h];
		1441
		1442	(my $map = $hash) =~ s/^.*?\/([^\/]+)$/\1/;
		1443	$STATWIDS->{map}->set_text ("Map: " . $map);
		1444
		1445	$self->load_map ($hash, $x, $y);
		1446	$self->flood_fill (0, 0, 0, "", $hash, $flags);
		1447	}
		1448
		1449	sub conn::face_find {
		1450	my ($self, $facenum, $face) = @_;
		1451
		1452	my $hash = "$face->{chksum},$face->{name}";
		1453
		1454	my $id = $FACEMAP->get ($hash);
		1455
		1456	unless ($id) {
		1457	# create new id for face
		1458	# I love transactions
		1459	for (1..100) {
		1460	my $txn = $CFClient::DB_ENV->txn_begin;
		1461	my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW);
		1462	if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) {
		1463	$id = ($id || 16) + 1;
		1464	if ($FACEMAP->put (id => $id) == 0
		1465	&& $FACEMAP->put ($hash => $id) == 0) {
		1466	$txn->txn_commit;
		1467
		1468	goto gotid;
		1469	}
		1470	}
		1471	$txn->abort;
		1472	}
		1473
		1474	CFClient::fatal "maximum number of transaction retries reached - database problems?";
		1475	}
		1476
		1477	gotid:
		1478	$face->{id} = $id;
		1479	$MAP->set_face ($facenum => $id);
		1480	$self->{faceid}[$facenum] = $id;#d#
		1481
		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	};
		1487	}
		1488
		1489	sub conn::face_update {
		1490	my ($self, $facenum, $face) = @_;
		1491
		1492	$TILECACHE->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes
		1493
		1494	$self->set_texture ($face->{id} => delete $face->{image});
		1495	}
		1496
		1497	sub conn::set_texture {
		1498	my ($self, $id, $data) = @_;
		1499
		1500	$self->{texture}[$id] ||= do {
		1501	my $tex =
		1502	new_from_image CFClient::Texture
		1503	$data, minify => 1, mipmap => 1;
		1504
		1505	$MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
		1506	$MAPWIDGET->update;
		1507
		1508	$tex
		1509	};
		1510	}
		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
		1527	sub conn::query {
		1528	my ($self, $flags, $prompt) = @_;
		1529
		1530	$prompt = $LAST_QUERY unless length $prompt;
		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;
		1590	}
		1591
		1592	sub conn::drawinfo {
		1593	my ($self, $color, $text) = @_;
		1594
		1595	my @color = (
		1596	[1.00, 1.00, 1.00], #[0.00, 0.00, 0.00],
		1597	[1.00, 1.00, 1.00],
		1598	[0.50, 0.50, 1.00], #[0.00, 0.00, 0.55]
		1599	[1.00, 0.00, 0.00],
		1600	[1.00, 0.54, 0.00],
		1601	[0.11, 0.56, 1.00],
		1602	[0.93, 0.46, 0.00],
		1603	[0.18, 0.54, 0.34],
		1604	[0.56, 0.73, 0.56],
		1605	[0.80, 0.80, 0.80],
		1606	[0.55, 0.41, 0.13],
		1607	[0.99, 0.77, 0.26],
		1608	[0.74, 0.65, 0.41],
		1609	);
		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
		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	}
276	}	1788	}
277		1789
278	%SDL_CB = (	1790	%SDL_CB = (
279	SDL_QUIT() => sub {	1791	CFClient::SDL_QUIT => sub {
280	main_quit Gtk2;	1792	Event::unloop -1;
281	},	1793	},
282	SDL_VIDEORESIZE() => sub {	1794	CFClient::SDL_VIDEORESIZE => sub {
283	},	1795	},
284	SDL_VIDEOEXPOSE() => sub {	1796	CFClient::SDL_VIDEOEXPOSE => sub {
285	refresh;	1797	CFClient::UI::full_refresh;
286	},	1798	},
287	SDL_KEYDOWN() => sub {
288	if ($SDL_EV->key_mod & KMOD_ALT && $SDL_EV->key_sym == SDLK_RETURN) {
289	# alt-enter
290	$FULLSCREEN = !$FULLSCREEN;
291	init_screen;
292	} else {
293	CFClient::UI::feed_sdl_key_down_event ($SDL_EV);
294	}
295	},
296	SDL_KEYUP() => sub {
297	CFClient::UI::feed_sdl_key_up_event ($SDL_EV);
298	},
299	SDL_MOUSEMOTION() => sub {
300	CFClient::UI::feed_sdl_motion_event ($SDL_EV);
301	},
302	SDL_MOUSEBUTTONDOWN() => sub {
303	CFClient::UI::feed_sdl_button_down_event ($SDL_EV);
304	},
305	SDL_MOUSEBUTTONUP() => sub {
306	CFClient::UI::feed_sdl_button_up_event ($SDL_EV);
307	},
308	SDL_ACTIVEEVENT() => sub {	1799	CFClient::SDL_ACTIVEEVENT => sub {
309	# 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#
310	},	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	},
311	);	1823	);
312		1824
313	@conn::ISA = Crossfire::Protocol::;
314
315	sub conn::map_update {
316	my ($self, $dirty) = @_;
317
318	$MAPWIDGET->update;
319	}
320
321	sub conn::map_scroll {
322	my ($self, $dx, $dy) = @_;
323
324	# refresh;
325	}
326
327	sub conn::map_clear {
328	my ($self) = @_;
329
330	# refresh;
331	}
332
333	sub conn::face_find {
334	my ($self, $face) = @_;
335
336	$FACECACHE->{"$face->{chksum},$face->{name}"}
337	}
338
339	sub conn::face_update {
340	my ($self, $face) = @_;
341
342	$FACECACHE->{"$face->{chksum},$face->{name}"} = $face->{image};
343
344	$face->{texture} = new_from_image CFClient::Texture delete $face->{image};
345	}
346
347	sub conn::query {
348	my ($self, $flags, $prompt) = @_;
349
350	warn "<<<<QUERY:$flags:$prompt>>>\n";#d#
351	}
352
353	sub gtk_add_cfg_field {
354	my ($tbl, $cfg, $klbl, $key, $value) = @_;
355	my $i = $cfg->{_i}++;
356	$tbl->attach_defaults (my $lbl = Gtk2::Label->new ($klbl), 0, 1, $i, $i + 1);
357	$tbl->attach_defaults (my $ent = Gtk2::Entry->new, 1, 2, $i, $i + 1);
358	if ($key eq 'password') {
359	$ent->set_invisible_char ("*");
360	$ent->set (visibility => 0)
361	}
362	$ent->set_text ($value);
363	$ent->signal_connect (changed => sub {
364	my ($ent) = @_;
365	$cfg->{$key} = $ent->get_text;
366	# TODO: Mapsize should be a slider in the game gui
367	if ($key eq 'mapsize' and $cfg->{$key} > 100) {
368	$cfg->{$key} = 100;
369	} elsif ($key eq 'mapsize' and $cfg->{$key} < 50) {
370	$cfg->{$key} = 50;
371	}
372	});
373	}
374
375	sub run_config_dialog {
376	my (%events) = @_;
377
378	my $w = Gtk2::Window->new;
379
380	my @cfg = (
381	[qw/Host host/],
382	[qw/Port port/],
383	[qw/Mapsize% mapsize/],
384	[qw/Username user/],
385	[qw/Password password/],
386	);
387
388	my $cfg = {};
389
390	$w->add (my $vb = Gtk2::VBox->new);
391	$vb->pack_start (my $t = Gtk2::Table->new (2, scalar @cfg), 0, 0, 0);
392	my $selmode = $::CFG->{width} . 'x' . $::CFG->{height};
393	$t->attach_defaults (Gtk2::Label->new ("Modes"), 0, 1, 0, 1);
394	$t->attach_defaults (my $cb = Gtk2::ComboBox->new_text, 1, 2, 0, 1);
395	my $i = 0;
396	my $act = 0;
397	for (map { "$_->[0]x$_->[1]" } @SDL_MODES) {
398	if ($_ eq $selmode) { $act = $i }
399	$cb->append_text ($_);
400	$i++;
401	}
402	$cb->set_active ($act);
403	$cb->signal_connect (changed => sub {
404	my ($cb) = @_;
405	my $txt = $cb->get_active_text;
406	if ($txt =~ m/(\d+)x(\d+)/) {
407	$::CFG->{width} = $1;
408	$::CFG->{height} = $2;
409	}
410	});
411
412	$cfg->{_i} = 1;
413	for (@cfg) {
414	gtk_add_cfg_field ($t, $cfg, $_->[0], $_->[1], $::CFG->{$_->[1]});
415	}
416
417	$vb->pack_start (my $hb = Gtk2::HBox->new, 0, 0, 0);
418	$hb->pack_start (my $cb = Gtk2::Button->new ("save"), 1, 1, 5);
419	$cb->signal_connect (clicked => sub {
420	for (keys %$cfg) {
421	$::CFG->{$_} = $cfg->{$_}
422	if $_ ne '_i';
423	}
424	CFClient::write_cfg "$CFrossfire::VARDIR/pclientrc";
425	});
426	$hb->pack_start (my $cb = Gtk2::Button->new ("login"), 1, 1, 5);
427	$cb->signal_connect (clicked => sub {
428	for (keys %$cfg) {
429	$::CFG->{$_} = $cfg->{$_}
430	if $_ ne '_i';
431	}
432	my $cb = $events{login} || sub {};
433	$cb->($::CFG->{user}, $::CFG->{password});
434	});
435	$hb->pack_start (my $cb = Gtk2::Button->new ("logout"), 1, 1, 5);
436	$cb->signal_connect (clicked => sub {
437	my $cb = $events{logout} || sub {};
438	$cb->();
439	});
440	$hb->pack_start (my $cb = Gtk2::Button->new ("quit"), 1, 1, 5);
441	$cb->signal_connect (clicked => sub { $w->destroy });
442
443	$w->show_all;
444
445	$w->signal_connect (destroy => sub { Gtk2->main_quit });
446	}
447
448
449	#############################################################################	1825	#############################################################################
450		1826
451	SDL::Init SDL_INIT_EVERYTHING;	1827	$SIG{INT} = $SIG{TERM} = sub { exit };
452
453	@SDL_MODES = reverse map [SDL::RectW ($_), SDL::RectH ($_)],
454	@{ SDL::ListModes 0, SDL_FULLSCREEN|SDL_HWSURFACE };
455
456	CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
457
458	$CFG ||= {
459	width => 640,
460	height => 480,
461	mapsize => 100,
462	fullscreen => 0,
463	host => "crossfire.schmorp.de",
464	port => 13327,
465	};
466		1828
467	{	1829	{
468	my @fonts = map CFClient::find_rcfile $_, qw(uifont.ttf uifontb.ttf uifonti.ttf uifontbi.ttf);	1830	local $SIG{__DIE__} = sub { CFClient::fatal $_[0] };
469		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
470	CFClient::add_font $_ for @fonts;	1888	CFClient::add_font $_ for @fonts;
471	CFClient::set_font $fonts[0];	1889
472	}	1890	CFClient::pango_init;
473		1891
474	$FACECACHE = eval { Crossfire::load_ref "$Crossfire::VARDIR/pclient.faces" } || {};	1892	$FONT_PROP = new_from_file CFClient::Font $fonts[0];
		1893	$FONT_FIXED = new_from_file CFClient::Font $fonts[1];
475		1894
476	run_config_dialog	1895	$FONT_PROP->make_default;
477	login => sub { start_game },	1896	}
478	logout => sub { stop_game };
479		1897
480	main Gtk2;	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	# }
481		1910
482	Crossfire::save_ref $FACECACHE, "$Crossfire::VARDIR/pclient.faces";	1911	video_init;
		1912	audio_init;
		1913	}
		1914
		1915	Event::loop;
		1916
		1917	END { CFClient::SDL_Quit }
		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