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

Diff Legend

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