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

Diff Legend

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