ViewVC Help

View File | Revision Log | Show Annotations | Download File

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

Comparing deliantra/Deliantra-Client/bin/pclient (file contents):
Revision 1.119 by root, Mon Apr 17 06:50:26 2006 UTC vs.
Revision 1.206 by root, Tue May 9 22:27:55 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	use SDL::OpenGL;
14
15	use Crossfire;	32	use Crossfire;
16	use Crossfire::Protocol;	33	use Crossfire::Protocol;
17		34
18	use Compress::LZF;	35	use Compress::LZF;
19		36
20	use CFClient;	37	use CFClient;
21	use CFClient::UI;	38	use CFClient::UI;
		39	use CFClient::MapWidget;
		40
		41	$Event::DIED = sub {
		42	CFClient::error $_[1];
		43	};
		44
		45	#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#
22		46
23	our $VERSION = '0.1';	47	our $VERSION = '0.1';
24		48
25	my $MAX_FPS = 60;	49	my $MAX_FPS = 60;
26	my $MIN_FPS = 5; # unused as of yet	50	my $MIN_FPS = 5; # unused as of yet
…		…
35	our $NOW;	59	our $NOW;
36		60
37	our $CFG;	61	our $CFG;
38	our $CONN;	62	our $CONN;
39	our $FAST; # fast, low-quality mode, possibly useful for software-rendering	63	our $FAST; # fast, low-quality mode, possibly useful for software-rendering
		64
		65	our $WANT_REFRESH;
		66	our $CAN_REFRESH;
40		67
41	our @SDL_MODES;	68	our @SDL_MODES;
42	our $WIDTH;	69	our $WIDTH;
43	our $HEIGHT;	70	our $HEIGHT;
44	our $FULLSCREEN;	71	our $FULLSCREEN;
45	our $FONTSIZE;	72	our $FONTSIZE;
46		73
		74	our $FONT_PROP;
		75	our $FONT_FIXED;
		76
47	our $MAP;	77	our $MAP;
		78	our $MAPMAP;
48	our $MAPWIDGET;	79	our $MAPWIDGET;
49	our $BUTTONBAR;	80	our $BUTTONBAR;
50	our $LOGVIEW;	81	our $LOGVIEW;
51	our $CONSOLE;	82	our $CONSOLE;
52	our $METASERVER;	83	our $METASERVER;
		84	our $LOGIN_BUTTON;
		85
		86	our $FLOORBOX;
		87	our $GAUGES;
		88	our $STATWIDS;
53		89
54	our $SDL_ACTIVE;	90	our $SDL_ACTIVE;
55	our $SDL_EV;
56	our %SDL_CB;	91	our %SDL_CB;
		92
		93	our $SDL_MIXER;
		94	our @SOUNDS; # event => file mapping
		95	our %AUDIO_CHUNKS; # audio files
57		96
58	our $ALT_ENTER_MESSAGE;	97	our $ALT_ENTER_MESSAGE;
59	our $STATUS_LINE;	98	our $STATUS_LINE;
60	our $DEBUG_STATUS;	99	our $DEBUG_STATUS;
61		100
		101	our $INVWIN;
		102	our $INV;
		103
62	sub status {	104	sub status {
63	$STATUS_LINE->set_text ($_[0]);	105	$STATUS_LINE->set_text ($_[0]);
64	my ($w, $h) = $STATUS_LINE->size_request;
65	$STATUS_LINE->size_allocate (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $h, $w, $h);	106	$STATUS_LINE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $STATUS_LINE->{h});
66	}	107	}
67		108
68	sub debug {	109	sub debug {
69	$DEBUG_STATUS->set_text ($_[0]);	110	$DEBUG_STATUS->set_text ($_[0]);
70	my ($w, $h) = $DEBUG_STATUS->size_request;	111	my ($w, $h) = $DEBUG_STATUS->size_request;
71	$DEBUG_STATUS->size_allocate ($WIDTH - $w, 0, $w, $h);	112	$DEBUG_STATUS->move ($WIDTH - $w, 0);
72	}	113	}
73		114
74	sub start_game {	115	sub start_game {
75	status "logging in...";	116	status "logging in...";
76		117
77	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;	118	my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
78		119
79	$MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";	120	$MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";
80
81	$MAP = new CFClient::Map $mapsize, $mapsize;	121	$MAP = new CFClient::Map $mapsize, $mapsize;
82		122
83	my ($host, $port) = split /:/, $CFG->{host};	123	my ($host, $port) = split /:/, $CFG->{host};
84		124
85	$CONN = new conn	125	$CONN = eval {
		126	new conn
86	host => $host,	127	host => $host,
87	port => $port || 13327,	128	port => $port || 13327,
88	user => $CFG->{user},	129	user => $CFG->{user},
89	pass => $CFG->{password},	130	pass => $CFG->{password},
90	mapw => $mapsize,	131	mapw => $mapsize,
91	maph => $mapsize,	132	maph => $mapsize,
		133	;
92	;	134	};
93		135
		136	if ($CONN) {
		137	$LOGIN_BUTTON->set_text ("Logout");
		138
94	status "login successful";	139	status "login successful";
95		140
96	CFClient::lowdelay fileno $CONN->{fh};	141	CFClient::lowdelay fileno $CONN->{fh};
		142	} else {
		143	status "unable to connect";
		144	stop_game();
		145	}
97	}	146	}
98		147
99	sub stop_game {	148	sub stop_game {
		149	return unless $CONN;
		150
		151	status "connection closed";
		152	$LOGIN_BUTTON->set_text ("Login");
		153	$CONN->destroy;
		154	$CONN = 0; # false, does not autovivify
		155
		156	undef $MAPCACHE;
100	undef $CONN;	157	undef $MAP;
101	}	158	}
102		159
103	sub client_setup {	160	sub client_setup {
104	my $dialog = new CFClient::UI::FancyFrame	161	my $dialog = new CFClient::UI::FancyFrame
		162	title => "Client Setup",
105	child => (my $vbox = new CFClient::UI::VBox);	163	child => (my $vbox = new CFClient::UI::VBox);
106	$vbox->add (new CFClient::UI::Label align => 0, text => "Client Setup");
107	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);	164	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
108		165
109	$table->add (0, 0, new CFClient::UI::Label align => 1, text => "Video Mode");	166	$table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode");
110	$table->add (1, 0, my $hbox = new CFClient::UI::HBox);	167	$table->add (1, 0, my $hbox = new CFClient::UI::HBox);
111		168
112	$hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1]);	169	$hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1]);
113	$hbox->add (my $mode_label = new CFClient::UI::Label height => $FONTSIZE * 0.8);	170	$hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");
114		171
115	$mode_slider->connect (changed => sub {	172	$mode_slider->connect (changed => sub {
116	my ($self, $value) = @_;	173	my ($self, $value) = @_;
117		174
118	$CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;	175	$CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
119	$mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});	176	$mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});
120	});	177	});
121	$mode_slider->emit (changed => $mode_slider->{range}[0]);	178	$mode_slider->emit (changed => $mode_slider->{range}[0]);
122		179
		180	my $row = 1;
		181
123	$table->add (0, 1, new CFClient::UI::Label align => 1, text => "Fullscreen");	182	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
124	$table->add (1, 1, new CFClient::UI::CheckBox state => $CFG->{fullscreen}, connect_changed => sub {	183	$table->add (1, $row++, new CFClient::UI::CheckBox
		184	state => $CFG->{fullscreen},
		185	tooltip => "Bring the client into fullscreen mode",
		186	connect_changed => sub {
125	my ($self, $value) = @_;	187	my ($self, $value) = @_;
126	$CFG->{fullscreen} = $value;	188	$CFG->{fullscreen} = $value;
		189	}
127	});	190	);
128		191
129	$table->add (0, 2, new CFClient::UI::Label align => 1, text => "Fast & Ugly");	192	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
130	$table->add (1, 2, new CFClient::UI::CheckBox state => $CFG->{fast}, connect_changed => sub {	193	$table->add (1, $row++, new CFClient::UI::CheckBox
		194	state => $CFG->{fast},
		195	tooltip => "Lower the visual quality considerably to speed up rendering.",
		196	connect_changed => sub {
131	my ($self, $value) = @_;	197	my ($self, $value) = @_;
132	$CFG->{fast} = $value;	198	$CFG->{fast} = $value;
		199	}
133	});	200	);
134		201
135	$table->add (0, 3, new CFClient::UI::Label align => 1, text => "Fog of War");	202	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
136	$table->add (1, 3, new CFClient::UI::CheckBox state => $CFG->{fow_enable}, connect_changed => sub {	203	$table->add (1, $row++, new CFClient::UI::Slider
		204	range => [$CFG->{map_scale}, 0.25, 2, 0.05],
		205	tooltip => "Enlarge or shrink the displayed map",
		206	connect_changed => sub {
137	my ($self, $value) = @_;	207	my ($self, $value) = @_;
		208	$CFG->{map_scale} = 0.05 * int $value / 0.05;
		209	}
		210	);
		211
		212	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
		213	$table->add (1, $row++, new CFClient::UI::CheckBox
		214	state => $CFG->{fow_enable},
		215	tooltip => "Fog-of-War marks areas that cannot be seen by the player",
		216	connect_changed => sub {
		217	my ($self, $value) = @_;
138	$CFG->{fow_enable} = $value;	218	$CFG->{fow_enable} = $value;
		219	}
139	});	220	);
140		221
141	$table->add (0, 4, new CFClient::UI::Label align => 1, text => "FoW Intensity");	222	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
142	$table->add (1, 4, new CFClient::UI::Slider range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001], connect_changed => sub {	223	$table->add (1, $row++, new CFClient::UI::Slider
		224	range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001],
		225	tooltip => "The higher the intensity, the lighter the Fog-of-War color",
		226	connect_changed => sub {
143	my ($self, $value) = @_;	227	my ($self, $value) = @_;
144	$CFG->{fow_intensity} = $value;	228	$CFG->{fow_intensity} = $value;
		229	}
145	});	230	);
146		231
147	$table->add (0, 5, new CFClient::UI::Label align => 1, text => "FoW Smooth");	232	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
148	$table->add (1, 5, new CFClient::UI::CheckBox state => $CFG->{fow_smooth}, connect_changed => sub {	233	$table->add (1, $row++, new CFClient::UI::CheckBox
		234	state => $CFG->{fow_smooth},
		235	tooltip => "Smooth the Fog-of-War a bit to make it more realistic",
		236	connect_changed => sub {
149	my ($self, $value) = @_;	237	my ($self, $value) = @_;
150	$CFG->{fow_smooth} = $value;	238	$CFG->{fow_smooth} = $value;
		239	status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2;
		240	}
		241	);
		242
		243	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
		244	$table->add (1, $row++, new CFClient::UI::Slider
		245	range => [$CFG->{gui_fontsize}, 0.5, 2, 0.1],
		246	tooltip => "The font size used by most GUI elements",
		247	connect_changed => sub {
		248	$CFG->{gui_fontsize} = 0.1 * int $_[1] * 10;
		249	# $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
		250	}
		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],
		256	tooltip => "The font size used by the server log window only",
		257	connect_changed => sub {
		258	$LOGVIEW->set_fontsize ($CFG->{log_fontsize} = 0.1 * int $_[1] * 10);
		259	}
		260	);
		261
		262	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
		263
		264	$table->add (1, $row++, new CFClient::UI::Slider
		265	range => [$CFG->{stat_fontsize}, 0.5, 2, 0.1],
		266	tooltip => "The font size used by the statistics window only",
		267	connect_changed => sub {
		268	$CFG->{stat_fontsize} = 0.1 * int $_[1] * 10;
		269	&set_stats_window_fontsize;
		270	}
		271	);
		272
		273	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
		274	$table->add (1, $row++, new CFClient::UI::Slider
		275	range => [$CFG->{gauge_size}, 0.2, 0.8, 0.02],
		276	tooltip => "Adjust the size of the stats gauges at the bottom right",
		277	connect_changed => sub {
		278	$CFG->{gauge_size} = $_[1];
		279	my $h = int $HEIGHT * $CFG->{gauge_size};
		280	$GAUGES->{win}->set_size ($WIDTH, $h);
		281	$GAUGES->{win}->move (0, $HEIGHT - $h);
		282	}
		283	);
		284
		285	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
		286	$table->add (1, $row++, new CFClient::UI::Slider
		287	range => [$CFG->{gauge_fontsize}, 0.5, 2.0, 0.1],
		288	tooltip => "Adjusts the fontsize of the gauges at the bottom right",
		289	connect_changed => sub {
		290	$CFG->{gauge_fontsize} = 0.1 * int $_[1] * 10;
		291	&set_gauge_window_fontsize;
		292	}
		293	);
		294
		295	$table->add (1, $row++, new CFClient::UI::Button
		296	expand => 1, align => 0, text => "Apply",
		297	tooltip => "Apply the video settings",
		298	connect_activate => sub {
		299	video_shutdown ();
		300	video_init ();
		301	}
		302	);
		303
		304	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");
		305	$table->add (1, $row++, new CFClient::UI::CheckBox
		306	state => $CFG->{audio_enable},
		307	tooltip => "If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.",
		308	connect_changed => sub {
		309	$CFG->{audio_enable} = $_[1];
		310	}
		311	);
		312	# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume");
		313	# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], connect_changed => sub {
		314	# $CFG->{effects_volume} = $_[1];
151	});	315	# });
152
153	$table->add (0, 6, new CFClient::UI::Label align => 1, text => "Log Fontsize");	316	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");
154	$table->add (1, 6, new CFClient::UI::Slider range => [$CFG->{log_fontsize}, 8, 30, 1], connect_changed => sub {	317	$table->add (1, $row++, my $hbox = new CFClient::UI::HBox);
		318	$hbox->add (new CFClient::UI::CheckBox
		319	expand => 1, state => $CFG->{bgm_enable},
		320	tooltip => "Enable background music playing",
		321	connect_changed => sub {
		322	$CFG->{bgm_enable} = $_[1];
		323	}
		324	);
		325	$hbox->add (new CFClient::UI::Slider
		326	expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0.1],
		327	tooltip => "The volume of the background music",
		328	connect_changed => sub {
		329	$CFG->{bgm_volume} = $_[1];
		330	CFClient::MixMusic::volume $_[1] * 128;
		331	}
		332	);
		333
		334	$table->add (1, $row++, new CFClient::UI::Button
		335	expand => 1, align => 0, text => "Apply",
		336	tooltip => "Apply the audio settings",
		337	connect_activate => sub {
		338	audio_shutdown ();
		339	audio_init ();
		340	}
		341	);
		342
		343	$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Communication cmd");
		344	$table->add (1, $row++, my $saycmd = new CFClient::UI::Entry
		345	text => $CFG->{say_command},
		346	tooltip => "This is the command that will be used if you write a line in the message window entry. "
		347	."Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
		348	."But you could also set it to 'tell &lt;playername&gt;' to only chat with that user.",
		349	connect_changed => sub {
155	my ($self, $value) = @_;	350	my ($self, $value) = @_;
156	$LOGVIEW->set_fontsize ($CFG->{log_fontsize} = int $value);	351	$CFG->{say_command} = $value;
		352	}
157	});	353	);
158
159	$table->add (1, 7, new CFClient::UI::Button expand => 1, align => 0, text => "Apply", connect_activate => sub {
160	destroy_screen ();
161	init_screen ();
162	});
163		354
164	$dialog	355	$dialog
		356	}
		357
		358	sub set_stats_window_fontsize {
		359	for (values %{$STATWIDS}) {
		360	$_->set_fontsize ($::CFG->{stat_fontsize});
		361	}
		362	}
		363
		364	sub set_gauge_window_fontsize {
		365	for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {
		366	$_->set_fontsize ($::CFG->{gauge_fontsize});
		367	}
		368
		369	# local $GAUGES->{win}{parent};#d#
		370	# use PApp::Util; open D, ">:utf8", "d"; print D PApp::Util::dumpval $GAUGES->{win}; close D;
		371	}
		372
		373	sub make_gauge_window {
		374	my $gh = int ($HEIGHT * $CFG->{gauge_size});
		375	# my $gw = int ($WIDTH * $CFG->{gauge_w_size});
		376
		377	my $win = new CFClient::UI::Frame (
		378	y => $HEIGHT - $gh, x => 0, user_w => $WIDTH, user_h => $gh
		379	);
		380	$win->add (my $hbox = new CFClient::UI::HBox
		381	children => [
		382	(new CFClient::UI::HBox expand => 1),
		383	($FLOORBOX = new CFClient::UI::VBox),
		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
165	}	587	}
166		588
167	sub metaserver_dialog {	589	sub metaserver_dialog {
168	my $dialog = new CFClient::UI::FancyFrame	590	my $dialog = new CFClient::UI::FancyFrame
		591	title => "Server List",
169	child => (my $vbox = new CFClient::UI::VBox);	592	child => (my $vbox = new CFClient::UI::VBox);
170		593
171	$vbox->add ($dialog->{table} = new CFClient::UI::Table);	594	$vbox->add ($dialog->{table} = new CFClient::UI::Table);
172		595
173	$dialog	596	$dialog
174	}	597	}
		598
		599	my $METASERVER_ATIME;
175		600
176	sub update_metaserver {	601	sub update_metaserver {
177	my ($HOST) = @_;	602	my ($HOST) = @_;
178		603
179	status "fetching metaserver list...";	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...");
180		610
181	my $buf;	611	my $buf;
182		612
183	my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;	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	}
184		619
185	Event->io (fd => $fh, poll => 'r', cb => sub {	620	Event->io (fd => $fh, poll => 'r', cb => sub {
186	my $res = sysread $fh, $buf, 8192, length $buf;	621	my $res = sysread $fh, $buf, 8192, length $buf;
187		622
188	if (!defined $res) {	623	if (!defined $res) {
189	$_[0]->w->cancel;	624	$_[0]->w->cancel;
190	status "metaserver: $!";	625	$label->set_text ("error while retrieving server list: $!");
191	} elsif ($res == 0) {	626	} elsif ($res == 0) {
192	$_[0]->w->cancel;	627	$_[0]->w->cancel;
193	status "server list retrieved";	628	status "server list retrieved";
194		629
195	my $table = $METASERVER->{table};	630	utf8::decode $buf if utf8::valid $buf;
196		631
197	$table->clear;	632	$table->clear;
198		633
199	my @col = qw(Use #Users Host Uptime Version Description);	634	my @col = qw(Use #Users Host Uptime Version Description);
200	$table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])	635	$table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])
…		…
224	$m = [$users, $host, $uptime, $version, $desc];	659	$m = [$users, $host, $uptime, $version, $desc];
225		660
226	$y++;	661	$y++;
227		662
228	$table->add (0, $y, new CFClient::UI::VBox children => [	663	$table->add (0, $y, new CFClient::UI::VBox children => [
229	(new CFClient::UI::Button text => " ", connect_activate => sub {	664	(new CFClient::UI::Button text => "Use", connect_activate => sub {
230	$HOST->set_text ($CFG->{host} = $host);	665	$HOST->set_text ($CFG->{host} = $host);
231	}),	666	}),
232	(new CFClient::UI::Empty expand => 1),	667	(new CFClient::UI::Empty expand => 1),
233	]);	668	]);
234		669
235	$table->add ($_ + 1, $y, new CFClient::UI::Label align => $align[$_], text => $m->[$_], fontsize => $FONTSIZE * 0.8)	670	$table->add ($_ + 1, $y, new CFClient::UI::Label align => $align[$_], text => $m->[$_], fontsize => 0.8)
236	for 0 .. $#$m;	671	for 0 .. $#$m;
237	}	672	}
238	}	673	}
239	});	674	});
240	}	675	}
241		676
242	sub server_setup {	677	sub server_setup {
243	my $dialog = new CFClient::UI::FancyFrame	678	my $dialog = new CFClient::UI::FancyFrame
		679	title => "Server Setup",
244	child => (my $vbox = new CFClient::UI::VBox);	680	child => (my $vbox = new CFClient::UI::VBox);
245		681
246	$vbox->add (new CFClient::UI::Label align => 0, text => "Server Setup");
247	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);	682	$vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
248	$table->add (0, 2, new CFClient::UI::Label align => 1, text => "Host:Port");	683	$table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
249		684
250	{	685	{
251	$table->add (1, 2, my $vbox = new CFClient::UI::VBox);	686	$table->add (1, 2, my $vbox = new CFClient::UI::VBox);
252		687
253	$vbox->add (my $HOST = new CFClient::UI::Entry text => $CFG->{host}, connect_changed => sub {	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;
		696	}
		697	);
		698
		699	$METASERVER = metaserver_dialog;
		700
		701	$vbox->add (new CFClient::UI::Flopper
		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;
		708	}
		709	);
		710	}
		711
		712	$table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
		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 {
254	my ($self, $value) = @_;	717	my ($self, $value) = @_;
255	$CFG->{host} = $value;	718	$CFG->{user} = $value;
256	});	719	}
		720	);
257		721
258	$METASERVER = metaserver_dialog;
259
260	$vbox->add (new CFClient::UI::Flopper text => "Metaserver", other => $METASERVER, connect_open => sub {
261	update_metaserver $HOST;
262	});
263	}
264
265	$table->add (0, 4, new CFClient::UI::Label align => 1, text => "Username");	722	$table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
266	$table->add (1, 4, new CFClient::UI::Entry text => $CFG->{user}, connect_changed => sub {	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 {
267	my ($self, $value) = @_;	728	my ($self, $value) = @_;
268	$CFG->{user} = $value;
269	});
270
271	$table->add (0, 5, new CFClient::UI::Label align => 1, text => "Password");
272	$table->add (1, 5, new CFClient::UI::Entry text => $CFG->{password}, hidden => 1, connect_changed => sub {
273	my ($self, $value) = @_;
274	$CFG->{password} = $value;	729	$CFG->{password} = $value;
		730	}
275	});	731	);
276		732
277	$table->add (0, 6, new CFClient::UI::Label align => 1, text => "Def. say cmd");
278	$table->add (1, 6, my $saycmd = new CFClient::UI::Entry text => $CFG->{say_command}, connect_changed => sub {
279	my ($self, $value) = @_;
280	$CFG->{say_command} = $value;
281	});
282
283	$table->add (0, 7, new CFClient::UI::Label align => 1, text => "Map Size");	733	$table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
284	$table->add (1, 7, new CFClient::UI::Slider	734	$table->add (1, 7, new CFClient::UI::Slider
285	req_w => 100,	735	req_w => 100,
286	range => [$CFG->{mapsize}, 10, 100 + 1, 1],	736	range => [$CFG->{mapsize}, 10, 100 + 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.",
287	connect_changed => sub {	739	connect_changed => sub {
288	my ($self, $value) = @_;	740	my ($self, $value) = @_;
289		741
290	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;	742	$CFG->{mapsize} = $self->{range}[0] = $value = int $value;
291	},	743	},
292	);	744	);
293		745
294	$table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Login", connect_activate => sub {	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
295	start_game;	752	: start_game;
		753	},
296	});	754	);
297		755
298	$dialog	756	$dialog
299	}	757	}
300		758
301	sub message_window {	759	sub message_window {
302	my $window = new CFClient::UI::FancyFrame	760	my $window = new CFClient::UI::FancyFrame
		761	title => "Messages",
303	border_bg => [1, 1, 1, 0.5],	762	border_bg => [1, 1, 1, 1],
304	bg => [0.3, 0.3, 0.3, 0.8],	763	bg => [0, 0, 0, 0.5],
305	user_w => $::WIDTH/4,	764	user_w => int $::WIDTH / 3,
306	user_h => $::HEIGHT,	765	user_h => int $::HEIGHT / 5,
307	child => (my $vbox = new CFClient::UI::VBox);	766	child => (my $vbox = new CFClient::UI::VBox);
308		767
309	$vbox->add ($LOGVIEW = new CFClient::UI::TextView	768	$vbox->add ($LOGVIEW = new CFClient::UI::TextView
310	expand => 1,	769	expand => 1,
		770	font => $FONT_FIXED,
311	fontsize => $::CFG->{log_fontsize},	771	fontsize => $::CFG->{log_fontsize},
312	);	772	);
313		773
314	$vbox->add (my $input = new CFClient::UI::LineEntry	774	$vbox->add (my $input = new CFClient::UI::Entry
315	connect_focus_in => sub {	775	connect_focus_in => sub {
316	my ($input, $prev_focus) = @_;	776	my ($input, $prev_focus) = @_;
317		777
318	delete $input->{refocus_map};	778	delete $input->{refocus_map};
319		779
…		…
325	connect_activate => sub {	785	connect_activate => sub {
326	my ($input, $text) = @_;	786	my ($input, $text) = @_;
327	$input->set_text ('');	787	$input->set_text ('');
328		788
329	if ($text =~ /^\/(.*)/) {	789	if ($text =~ /^\/(.*)/) {
330	$::CONN->user_send ("command $1");	790	$::CONN->user_send ($1);
331	} else {	791	} else {
332	my $say_cmd = $::CFG->{say_command} || 'say';	792	my $say_cmd = $::CFG->{say_command} || 'say';
333	$::CONN->user_send ("command $say_cmd $text");	793	$::CONN->user_send ("$say_cmd $text");
334	}	794	}
335	if ($input->{refocus_map}) {	795	if ($input->{refocus_map}) {
336	delete $input->{refocus_map};	796	delete $input->{refocus_map};
337	$MAPWIDGET->focus_in	797	$MAPWIDGET->focus_in
338	}	798	}
…		…
348	};	808	};
349		809
350	$window	810	$window
351	}	811	}
352		812
		813	sub make_inventory_window {
		814	my $invwin = new CFClient::UI::FancyFrame user_w => 300, user_h => 300, title => "Inventory";
		815	$invwin->add ($INV = new CFClient::UI::Inventory expand => 1);
		816	$invwin
		817	}
		818
353	sub sdl_init {	819	sub sdl_init {
354	#SDL::Init SDL_INIT_AUDIO | SDL_INIT_VIDEO | SDL_INIT_NOPARACHUTE	820	CFClient::SDL_Init
355	SDL::Init SDL_INIT_AUDIO | SDL_INIT_VIDEO
356	and die "SDL::Init failed!\n";	821	and die "SDL::Init failed!\n";
357	}	822	}
358		823
359	sub init_screen {	824	sub video_init {
360	sdl_init;	825	sdl_init;
		826
		827	$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
361		828
362	($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };	829	($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
363	$FULLSCREEN = $CFG->{fullscreen};	830	$FULLSCREEN = $CFG->{fullscreen};
364	$FAST = $CFG->{fast};	831	$FAST = $CFG->{fast};
365		832
366	SDL::GLSetAttribute SDL_GL_RED_SIZE, 5;	833	CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
367	SDL::GLSetAttribute SDL_GL_GREEN_SIZE, 5;
368	SDL::GLSetAttribute SDL_GL_BLUE_SIZE, 5;
369	SDL::GLSetAttribute SDL_GL_ALPHA_SIZE, 1;
370
371	SDL::GLSetAttribute SDL_GL_ACCUM_RED_SIZE, 0;
372	SDL::GLSetAttribute SDL_GL_ACCUM_GREEN_SIZE, 0;
373	SDL::GLSetAttribute SDL_GL_ACCUM_BLUE_SIZE, 0;
374	SDL::GLSetAttribute SDL_GL_ACCUM_ALPHA_SIZE, 0;
375
376	SDL::GLSetAttribute SDL_GL_DOUBLEBUFFER, 1;
377	SDL::GLSetAttribute SDL_GL_BUFFER_SIZE, 15;
378	SDL::GLSetAttribute SDL_GL_DEPTH_SIZE, 0;
379
380	SDL::SetVideoMode $WIDTH, $HEIGHT, 0,
381	SDL_HWSURFACE | SDL_ANYFORMAT | SDL_OPENGL | SDL_DOUBLEBUF
382	| ($FULLSCREEN ? SDL_FULLSCREEN : 0)
383	or die "SDL::SetVideoMode failed!\n";	834	or die "SDL_SetVideoMode failed!\n";
384
385	SDL::WMSetCaption "Crossfire+ Client", "Crossfire+";
386
387	$SDL_EV = new SDL::Event;
388	$SDL_EV->set_unicode (1);
389		835
390	$SDL_ACTIVE = 1;	836	$SDL_ACTIVE = 1;
391
392	$LAST_REFRESH = time - 0.01;	837	$LAST_REFRESH = time - 0.01;
393		838
394	CFClient::gl_init;	839	CFClient::gl_init;
395		840
396	$FONTSIZE = int $HEIGHT / 40;	841	$FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
		842
		843	$CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
397		844
398	#############################################################################	845	#############################################################################
399		846
		847	if ($DEBUG_STATUS) {
		848	# reconfigure all widgets
		849	$CFClient::UI::ROOT->reconfigure;
		850
		851	} else {
		852	# create the widgets
		853
400	$DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100;	854	$DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100, text => "hulla", x => 100;#d#
401	$CFClient::UI::ROOT->add ($DEBUG_STATUS);	855	$DEBUG_STATUS->show;
402		856
403	$STATUS_LINE = new CFClient::UI::Label	857	$STATUS_LINE = new CFClient::UI::Label
404	padding => 0,	858	padding => 0,
405	y => $HEIGHT * 44 / 45 - $FONTSIZE;	859	y => $HEIGHT - $FONTSIZE * 1.8;
406	$CFClient::UI::ROOT->add ($STATUS_LINE);	860	$STATUS_LINE->show;
407		861
408	$ALT_ENTER_MESSAGE = new CFClient::UI::Label	862	$ALT_ENTER_MESSAGE = new CFClient::UI::Label
409	padding => 0,	863	padding => 0,
410	y => $HEIGHT * 44 / 45,	864	fontsize => 0.8,
411	height => $HEIGHT / 45,
412	text => "Use <b>Alt-Enter</b> to toggle fullscreen mode";	865	markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode";
413	$CFClient::UI::ROOT->add ($ALT_ENTER_MESSAGE);	866	$ALT_ENTER_MESSAGE->show;
		867	$ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h});
414		868
415	$CFClient::UI::ROOT->add ($MAPWIDGET = new CFClient::UI::MapWidget);	869	CFClient::UI::FancyFrame->new (
416	$MAPWIDGET->focus_in;	870	border_bg => [1, 1, 1, 192/255],
		871	bg => [1, 1, 1, 0],
		872	child => ($MAPMAP = new CFClient::MapWidget::MapMap),
		873	)->show;
		874
		875	$MAPWIDGET = new CFClient::MapWidget;
417	$MAPWIDGET->connect (activate_console => sub {	876	$MAPWIDGET->connect (activate_console => sub {
418	my ($mapwidget, $preset) = @_;	877	my ($mapwidget, $preset) = @_;
419		878
420	if ($CONSOLE) {	879	if ($CONSOLE) {
421	$CONSOLE->{input}->{auto_activated} = 1;	880	$CONSOLE->{input}->{auto_activated} = 1;
422	$CONSOLE->{input}->focus_in;	881	$CONSOLE->{input}->focus_in;
423		882
424	if ($preset && $CONSOLE->{input}->get_text eq '') {	883	if ($preset && $CONSOLE->{input}->get_text eq '') {
425	$CONSOLE->{input}->set_text ($preset);	884	$CONSOLE->{input}->set_text ($preset);
		885	}
426	}	886	}
427	}	887	});
428	});	888	$MAPWIDGET->show;
		889	$MAPWIDGET->focus_in;
429		890
430	$CFClient::UI::ROOT->add ($BUTTONBAR = new CFClient::UI::HBox);	891	$BUTTONBAR = new CFClient::UI::HBox;
431		892
432	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup);	893	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup);
433	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup);	894	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup);
434	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);	895	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);
435		896
		897	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
		898
		899	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window);
		900	$BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => make_inventory_window);
		901
436	$BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {	902	$BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {
437	CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";	903	CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
438	status "Configuration Saved";	904	status "Configuration Saved";
439	});	905	});
440		906
		907	$BUTTONBAR->show;
		908
		909	# delay till geometry is constant
		910	$CFClient::UI::ROOT->on_refresh (startup => sub {
441	$BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup	911	$BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
		912	});
		913	force_refresh ();
		914	}
442	}	915	}
443		916
444	sub destroy_screen {	917	sub video_shutdown {
445	$CFClient::UI::ROOT->{children} = [];
446	undef $SDL_ACTIVE;	918	undef $SDL_ACTIVE;
		919	}
		920
		921	my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
		922	my $bgmusic;#TODO#hack#d#
		923
		924	sub audio_channel_finished {
		925	my ($channel) = @_;
		926
		927	warn "channel $channel finished\n";#d#
		928	}
		929
		930	sub audio_music_finished {
		931	return unless $CFG->{bgm_enable};
		932
		933	# TODO: hack, do play loop and mood music
		934	$bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/$bgmusic[0]";
		935	$bgmusic->play (0);
		936
		937	push @bgmusic, shift @bgmusic;
		938	}
		939
		940	sub audio_init {
		941	if ($CFG->{audio_enable}) {
		942	if (open my $fh, "<", CFClient::find_rcfile "sounds/config") {
		943	$SDL_MIXER = !CFClient::Mix_OpenAudio;
		944	CFClient::Mix_AllocateChannels 8;
		945	CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
		946
		947	audio_music_finished;
		948
		949	while (<$fh>) {
		950	next if /^\s*#/;
		951	next if /^\s*$/;
		952
		953	my ($file, $volume, $event) = split /\s+/, $_, 3;
		954
		955	push @SOUNDS, "$volume,$file";
		956
		957	$AUDIO_CHUNKS{"$volume,$file"} ||= do {
		958	my $chunk = new_from_file CFClient::MixChunk CFClient::find_rcfile "sounds/$file";
		959	$chunk->volume ($volume * 128 / 100);
		960	$chunk
		961	};
		962	}
		963	} else {
		964	status "unable to open sound config: $!";
		965	}
		966	}
		967	}
		968
		969	sub audio_shutdown {
		970	CFClient::Mix_CloseAudio if $SDL_MIXER;
447	undef $SDL_EV;	971	undef $SDL_MIXER;
448	SDL::Quit;	972	@SOUNDS = ();
		973	%AUDIO_CHUNKS = ();
449	}	974	}
450		975
451	my %animate_object;	976	my %animate_object;
452	my $animate_timer;	977	my $animate_timer;
453
454	my $want_refresh;
455	my $can_refresh;
456		978
457	my $fps = 9;	979	my $fps = 9;
458		980
459	sub force_refresh {	981	sub force_refresh {
460	$fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05;	982	$fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05;
461	debug sprintf "%3.2f", $fps;	983	debug sprintf "%3.2f", $fps;
462		984
463	$want_refresh = 0;
464	$can_refresh = 0;
465
466	$CFClient::UI::ROOT->draw;	985	$CFClient::UI::ROOT->draw;
		986	CFClient::SDL_GL_SwapBuffers;
467		987
468	SDL::GLSwapBuffers;	988	$WANT_REFRESH = 0;
469		989	$CAN_REFRESH = 0;
470	$LAST_REFRESH = $NOW;	990	$LAST_REFRESH = $NOW;
471	}	991	}
472		992
473	my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {	993	my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {
474	$NOW = time;	994	$NOW = time;
475		995
476	($SDL_CB{$SDL_EV->type} || sub { warn "unhandled event ", $SDL_EV->type })->()	996	($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
477	while $SDL_EV->poll;	997	for CFClient::SDL_PollEvent;
478		998
479	if (%animate_object) {	999	if (%animate_object) {
480	$_->animate ($LAST_REFRESH - $NOW) for values %animate_object;	1000	$_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
481	$want_refresh++;	1001	$WANT_REFRESH++;
482	}	1002	}
483		1003
484	if ($want_refresh) {	1004	if ($WANT_REFRESH) {
485	force_refresh;	1005	force_refresh;
486	} else {	1006	} else {
487	$can_refresh = 1;	1007	$CAN_REFRESH = 1;
488	}	1008	}
489	});	1009	});
490
491	sub refresh {
492	$want_refresh++;
493	}
494		1010
495	sub animation_start {	1011	sub animation_start {
496	my ($widget) = @_;	1012	my ($widget) = @_;
497	$animate_object{$widget} = $widget;	1013	$animate_object{$widget} = $widget;
498	}	1014	}
…		…
502	delete $animate_object{$widget};	1018	delete $animate_object{$widget};
503	}	1019	}
504		1020
505	@conn::ISA = Crossfire::Protocol::;	1021	@conn::ISA = Crossfire::Protocol::;
506		1022
		1023	sub conn::stats_update {
		1024	my ($self, $stats) = @_;
		1025
		1026	update_stats_window ($stats);
		1027	}
		1028
507	sub conn::user_send {	1029	sub conn::user_send {
508	my ($self, $command) = @_;	1030	my ($self, $command) = @_;
509		1031
510	$self->send ($command);	1032	$self->send_command ($command);
511	status $command;	1033	status $command;
512	}	1034	}
513		1035
514	sub conn::map_scroll {	1036	sub conn::map_scroll {
515	my ($self, $dx, $dy) = @_;	1037	my ($self, $dx, $dy) = @_;
…		…
534		1056
535	my ($hash, $x, $y, $w, $h) = @$map_info;	1057	my ($hash, $x, $y, $w, $h) = @$map_info;
536		1058
537	my $data = $MAP->get_rect ($x, $y, $w, $h);	1059	my $data = $MAP->get_rect ($x, $y, $w, $h);
538	$MAPCACHE->put ($hash => Compress::LZF::compress $data);	1060	$MAPCACHE->put ($hash => Compress::LZF::compress $data);
539
540	warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#	1061	#warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
541
542	}	1062	}
543		1063
544	sub conn::map_clear {	1064	sub conn::map_clear {
545	my ($self) = @_;	1065	my ($self) = @_;
546		1066
547	$self->flush_map;	1067	$self->flush_map;
548	delete $self->{neigh};	1068	delete $self->{neigh_map};
549		1069
550	$MAP->clear;	1070	$MAP->clear;
551	}	1071	}
552		1072
553		1073
554	sub conn::load_map($$$) {	1074	sub conn::load_map($$$) {
555	my ($self, $hash, $x, $y) = @_;	1075	my ($self, $hash, $x, $y) = @_;
556		1076
557	if (defined (my $data = $MAPCACHE->get ($hash))) {	1077	if (defined (my $data = $MAPCACHE->get ($hash))) {
558	$data = Compress::LZF::decompress $data;	1078	$data = Compress::LZF::decompress $data;
559	warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#	1079	#warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
560	for my $id ($MAP->set_rect ($x, $y, $data)) {	1080	for my $id ($MAP->set_rect ($x, $y, $data)) {
561	my $data = $TILECACHE->get ($id)	1081	my $data = $TILECACHE->get ($id)
562	or next;	1082	or next;
563		1083
564	$self->set_texture ($id => $data);	1084	$self->set_texture ($id => $data);
565	}	1085	}
566	}	1086	}
567	}	1087	}
568		1088
		1089	# this method does a "flood fill" into every tile direction
		1090	# it assumes that tiles are arranged in a rectangular grid,
		1091	# i.e. a map is the same as the left of the right map etc.
		1092	# failure to comply are harmless and result in display errors
		1093	# at worst.
569	sub conn::flood_fill {	1094	sub conn::flood_fill {
570	my ($self, $path, $hash, $flags, $x0, $y0, $x1, $y1) = @_;	1095	my ($self, $gx, $gy, $path, $hash, $flags) = @_;
571		1096
572	for my $tile (1..4) {	1097	# the server does not allow map paths > 6
573	next if $self->{neigh}{$hash}[$tile];	1098	return if 7 <= length $path;
		1099
		1100	my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
		1101
		1102	for (
		1103	[1, 0, -1],
		1104	[2, 1, 0],
		1105	[3, 0, 1],
		1106	[4, -1, 0],
		1107	) {
		1108	my ($tile, $dx, $dy) = @$_;
		1109
		1110	my $gx = $gx + $dx;
		1111	my $gy = $gy + $dy;
		1112
574	next unless $flags & (1 << ($tile - 1));	1113	next unless $flags & (1 << ($tile - 1));
		1114	next if $self->{neigh_grid}{$gx, $gy}++;
575		1115
576	my $neigh = $self->{neigh}{$hash} ||= [];	1116	my $neigh = $self->{neigh_map}{$hash} ||= [];
577		1117	if (my $info = $neigh->[$tile]) {
578	$self->send_mapinfo ("spatial $path$tile", sub {
579	my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;	1118	my ($flags, $x, $y, $w, $h, $hash) = @$info;
580		1119
581	warn "map<$path>_$tile=<$mode,$x,$y,$w,$h,$hash>\n";#d#
582	return if $mode ne "spatial";
583
584	$x += $MAP->ox;
585	$y += $MAP->oy;
586
587	$self->load_map ($hash, $x, $y);
588
589	$neigh->[$tile] = [$x, $y, $w, $h];
590
591	$self->flood_fill ("$path$tile", $hash, $flags, $x0, $y0, $x1, $y1)	1120	$self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags)
592	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;	1121	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
		1122
		1123	} else {
		1124	$self->send_mapinfo ("spatial $path$tile", sub {
		1125	my ($mode, $flags, $x, $y, $w, $h, $hash) = @_;
		1126
		1127	return if $mode ne "spatial";
		1128
		1129	$x += $MAP->ox;
		1130	$y += $MAP->oy;
		1131
		1132	$self->load_map ($hash, $x, $y)
		1133	unless $self->{neigh_map}{$hash}[5]++;#d#
		1134
		1135	$neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
		1136
		1137	$self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags)
		1138	if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1;
		1139	});
593	});	1140	}
594	}	1141	}
595	}	1142	}
596		1143
597	sub conn::map_change {	1144	sub conn::map_change {
598	my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;	1145	my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_;
599		1146
600	$self->flush_map;	1147	$self->flush_map;
601		1148
602	my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);	1149	my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
603		1150
604	warn "$ox $oy map_info<$flags, $x, $y, $w, $h, $hash>\n";#d#	1151	my $mapmapw = $MAPMAP->{w};
		1152	my $mapmaph = $MAPMAP->{h};
605		1153
606	my $mapmapw = 250;	1154	$self->{neigh_rect} = [
607	my $mapmaph = 250;	1155	$ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
		1156	$ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
		1157	];
608		1158
		1159	delete $self->{neigh_grid};
609	$self->flood_fill ("", $hash, $flags,	1160	$self->flood_fill (0, 0, "", $hash, $flags);
610	$ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
611	$ox + $mapmapw * 0.5, $oy + $mapmapw * 0.5);
612		1161
613	$x += $ox;	1162	$x += $ox;
614	$y += $oy;	1163	$y += $oy;
615		1164
616	$self->{map_info} = [$hash, $x, $y, $w, $h];	1165	$self->{map_info} = [$hash, $x, $y, $w, $h];
		1166
		1167	my $map = $self->{map_info}[0];
		1168	$map =~ s/^.*?\/([^\/]+)$/\1/;
		1169	$STATWIDS->{map}->set_text ("Map: " . $map);
617		1170
618	$self->load_map ($hash, $x, $y);	1171	$self->load_map ($hash, $x, $y);
619	}	1172	}
620		1173
621	sub conn::face_find {	1174	sub conn::face_find {
…		…
647	}	1200	}
648		1201
649	gotid:	1202	gotid:
650	$face->{id} = $id;	1203	$face->{id} = $id;
651	$MAP->set_face ($facenum => $id);	1204	$MAP->set_face ($facenum => $id);
		1205	$self->{faceid}[$facenum] = $id;#d#
652	$TILECACHE->get ($id)	1206	$TILECACHE->get ($id)
653	}	1207	}
654		1208
655	sub conn::face_update {	1209	sub conn::face_update {
656	my ($self, $facenum, $face) = @_;	1210	my ($self, $facenum, $face) = @_;
…		…
664	my ($self, $id, $data) = @_;	1218	my ($self, $id, $data) = @_;
665		1219
666	$self->{texture}[$id] ||= do {	1220	$self->{texture}[$id] ||= do {
667	my $tex =	1221	my $tex =
668	new_from_image CFClient::Texture	1222	new_from_image CFClient::Texture
669	$data, minify => 1;	1223	$data, minify => 1, mipmap => 1;
670		1224
671	$MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});	1225	$MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
672	$MAPWIDGET->update;	1226	$MAPWIDGET->update;
673		1227
674	$tex	1228	$tex
675	};	1229	};
676	}	1230	}
677		1231
		1232	sub conn::sound_play {
		1233	my ($self, $x, $y, $soundnum, $type) = @_;
		1234
		1235	$SDL_MIXER
		1236	or return;
		1237
		1238	my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
		1239	or return;
		1240
		1241	$chunk->play;
		1242	# warn "sound $x,$y,$soundnum,$type\n";#d#
		1243	}
		1244
		1245	my $LAST_QUERY; # server is stupid, stupid, stupid
		1246
678	sub conn::query {	1247	sub conn::query {
679	my ($self, $flags, $prompt) = @_;	1248	my ($self, $flags, $prompt) = @_;
680		1249
681	#TODO	1250	$prompt = $LAST_QUERY unless length $prompt;
682	warn "<<<<QUERY:$flags:$prompt>>>\n";#d#	1251	$LAST_QUERY = $prompt;
		1252
		1253	my $dialog = new CFClient::UI::FancyFrame
		1254	title => "Query",
		1255	child => my $vbox = new CFClient::UI::VBox;
		1256
		1257	$vbox->add (new CFClient::UI::Label
		1258	max_w => $::WIDTH * 0.4,
		1259	text => $prompt);
		1260
		1261	if ($flags & Crossfire::Protocol::CS_QUERY_YESNO) {
		1262	$vbox->add (my $hbox = new CFClient::HBox);
		1263	$hbox->add (new CFClient::Button
		1264	text => "No",
		1265	connect_activate => sub {
		1266	$self->send ("reply n");
		1267	$dialog->destroy;
		1268	$MAPWIDGET->focus_in;
		1269	}
		1270	);
		1271	$hbox->add (new CFClient::Button
		1272	text => "Yes",
		1273	connect_activate => sub {
		1274	$self->send ("reply y");
		1275	$dialog->destroy;
		1276	$MAPWIDGET->focus_in;
		1277	},
		1278	);
		1279
		1280	$dialog->focus_in;
		1281
		1282	} elsif ($flags & Crossfire::Protocol::CS_QUERY_SINGLECHAR) {
		1283	$dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";
		1284	$vbox->add (my $entry = new CFClient::UI::Entry
		1285	connect_changed => sub {
		1286	$self->send ("reply $_[1]");
		1287	$dialog->destroy;
		1288	$MAPWIDGET->focus_in;
		1289	},
		1290	);
		1291
		1292	$entry->focus_in;
		1293
		1294	} else {
		1295	$dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
		1296
		1297	$vbox->add (my $entry = new CFClient::UI::Entry
		1298	$flags & Crossfire::Protocol::CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (),
		1299	connect_activate => sub {
		1300	$self->send ("reply $_[1]");
		1301	$dialog->destroy;
		1302	$MAPWIDGET->focus_in;
		1303	},
		1304	);
		1305
		1306	$entry->focus_in;
		1307	}
		1308
		1309	$dialog->show;
683	}	1310	}
684		1311
685	sub conn::drawinfo {	1312	sub conn::drawinfo {
686	my ($self, $color, $text) = @_;	1313	my ($self, $color, $text) = @_;
687		1314
…		…
702	);	1329	);
703		1330
704	$LOGVIEW->add_paragraph ($color[$color], $text);	1331	$LOGVIEW->add_paragraph ($color[$color], $text);
705	}	1332	}
706		1333
		1334	sub conn::spell_add {
		1335	my ($self, $spell) = @_;
		1336
		1337	# TODO
		1338	# create a widget dynamically, using spell face (CF::Protocol downloads them)
		1339	$MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message});
		1340	$MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message});
		1341	}
		1342
		1343	sub conn::spell_delete {
		1344	my ($self, $spell) = @_;
		1345	}
		1346
		1347	sub conn::addme_success {
		1348	my ($self) = @_;
		1349
		1350	for my $skill (values %{$self->{skill_info}}) {
		1351	$MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'");
		1352	$MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'");
		1353	}
		1354
		1355	$MAPWIDGET->add_command ("pet\\_mode defend", "Tell pets to stay close to you and defend you");
		1356	$MAPWIDGET->add_command ("pet\\_mode arena", "Same as petmode attack, but also attack other players");
		1357	$MAPWIDGET->add_command ("pet\\_mode sad", "Search &amp; Destroy - tell pets to roam about and attack enemies");
		1358	$MAPWIDGET->add_command ("kill\\_pets", "kill your pets");
		1359	}
		1360
		1361	sub conn::eof {
		1362	stop_game;
		1363	}
		1364
		1365	sub update_floorbox {
		1366	$CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
		1367	return unless $CONN;
		1368
		1369	$FLOORBOX->clear;
		1370	$FLOORBOX->add (new CFClient::UI::Empty expand => 1);
		1371
		1372	# we basically have to use the same sorting as everybody else
		1373	$FLOORBOX->add (
		1374	map +(new CFClient::UI::InventoryItem item => $_),
		1375	@{ $CONN->{container}{0} }
		1376	);
		1377	});
		1378
		1379	$WANT_REFRESH++;
		1380	}
		1381
		1382	sub conn::container_add {
		1383	my ($self, $tag, $items) = @_;
		1384
		1385	update_floorbox if $tag == 0;
		1386
		1387	$INV->set_items ($self->{container}{$self->{player}{tag}})
		1388	if $tag == $self->{player}{tag};
		1389
		1390	# $self-<{player}{tag} => player inv
		1391	#use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
		1392	}
		1393
		1394	sub conn::container_clear {
		1395	my ($self, $tag) = @_;
		1396
		1397	update_floorbox if $tag == 0;
		1398
		1399	$INV->set_items ($self->{container}{$tag})
		1400	if $tag == $self->{player}{tag};
		1401
		1402	# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
		1403	}
		1404
		1405	sub conn::item_delete {
		1406	my ($self, @items) = @_;
		1407
		1408	for (@items) {
		1409	update_floorbox if $_->{container} == 0;
		1410
		1411	$INV->set_items ($self->{container}{$_->{container}})
		1412	if $_->{container} == $self->{player}{tag};
		1413	}
		1414	}
		1415
		1416	sub conn::item_update {
		1417	my ($self, $item) = @_;
		1418
		1419	update_floorbox if $item->{container} == 0;
		1420
		1421	$INV->set_items ($self->{container}{$item->{container}})
		1422	if $item->{container} == $self->{player}{tag};
		1423	}
		1424
707	%SDL_CB = (	1425	%SDL_CB = (
708	SDL_QUIT() => sub {	1426	CFClient::SDL_QUIT => sub {
709	Event::unloop -1;	1427	Event::unloop -1;
710	},	1428	},
711	SDL_VIDEORESIZE() => sub {	1429	CFClient::SDL_VIDEORESIZE => sub {
712	},	1430	},
713	SDL_VIDEOEXPOSE() => sub {	1431	CFClient::SDL_VIDEOEXPOSE => sub {
714	refresh;	1432	$WANT_REFRESH++;
715	},	1433	},
716	SDL_KEYDOWN() => sub {
717	if ($SDL_EV->key_mod & KMOD_ALT && $SDL_EV->key_sym == SDLK_RETURN) {
718	# alt-enter
719	destroy_screen;
720	$CFG->{fullscreen} = !$CFG->{fullscreen};
721	init_screen;
722	} else {
723	CFClient::UI::feed_sdl_key_down_event ($SDL_EV);
724	}
725	},
726	SDL_KEYUP() => sub {
727	CFClient::UI::feed_sdl_key_up_event ($SDL_EV);
728	},
729	SDL_MOUSEMOTION() => sub {
730	CFClient::UI::feed_sdl_motion_event ($SDL_EV);
731	},
732	SDL_MOUSEBUTTONDOWN() => sub {
733	CFClient::UI::feed_sdl_button_down_event ($SDL_EV);
734	},
735	SDL_MOUSEBUTTONUP() => sub {
736	CFClient::UI::feed_sdl_button_up_event ($SDL_EV);
737	},
738	SDL_ACTIVEEVENT() => sub {	1434	CFClient::SDL_ACTIVEEVENT => sub {
739	# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#	1435	# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
740	},	1436	},
		1437	CFClient::SDL_KEYDOWN => sub {
		1438	if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
		1439	# alt-enter
		1440	video_shutdown;
		1441	$CFG->{fullscreen} = !$CFG->{fullscreen};
		1442	video_init;
		1443	} else {
		1444	CFClient::UI::feed_sdl_key_down_event ($_[0]);
		1445	}
		1446	},
		1447	CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
		1448	CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
		1449	CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
		1450	CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
		1451	CFClient::SDL_USEREVENT => sub {
		1452	if ($_[0]{code} == 1) {
		1453	audio_channel_finished $_[0]{data1};
		1454	} elsif ($_[0]{code} == 0) {
		1455	audio_music_finished;
		1456	}
		1457	},
741	);	1458	);
742		1459
743	#############################################################################	1460	#############################################################################
744		1461
745	$TILECACHE = CFClient::db_table "tilecache";	1462	$SIG{INT} = $SIG{TERM} = sub { exit };
746	$FACEMAP = CFClient::db_table "facemap";
747
748	CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
749
750	my %DEF_CFG = (
751	sdl_mode => 0,
752	width => 640,
753	height => 480,
754	fullscreen => 0,
755	fast => 0,
756	fow_enable => 1,
757	fow_intensity => 0.45,
758	fow_smooth => 0,
759	log_fontsize => 14,
760	mapsize => 100,
761	host => "crossfire.schmorp.de",
762	say_command => 'say',
763	);
764
765	while (my ($k, $v) = each %DEF_CFG) {
766	$CFG->{$k} = $v unless exists $CFG->{$k};
767	}
768
769	sdl_init;
770
771	@SDL_MODES = reverse
772	grep $_->[0] >= 640 && $_->[1] >= 480,
773	map [SDL::RectW ($_), SDL::RectH ($_)],
774	@{ SDL::ListModes 0, SDL_FULLSCREEN | SDL_HWSURFACE | SDL_OPENGL };
775
776	@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
777
778	$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
779
780	init_screen;
781		1463
782	{	1464	{
783	my @fonts = map CFClient::find_rcfile $_, qw(uifont.ttf uifontb.ttf uifonti.ttf uifontbi.ttf);	1465	local $SIG{__DIE__} = sub { CFClient::fatal $_[0] };
784		1466
		1467	CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
		1468
		1469	$TILECACHE = CFClient::db_table "tilecache";
		1470	$FACEMAP = CFClient::db_table "facemap";
		1471
		1472	my %DEF_CFG = (
		1473	sdl_mode => 0,
		1474	width => 640,
		1475	height => 480,
		1476	fullscreen => 0,
		1477	fast => 0,
		1478	map_scale => 0.5,
		1479	fow_enable => 1,
		1480	fow_intensity => 0.45,
		1481	fow_smooth => 0,
		1482	gui_fontsize => 1,
		1483	log_fontsize => 1,
		1484	gauge_fontsize=> 1,
		1485	gauge_size => 0.35,
		1486	stat_fontsize => 1,
		1487	mapsize => 100,
		1488	host => "crossfire.schmorp.de",
		1489	say_command => 'say',
		1490	audio_enable => 1,
		1491	bgm_enable => 1,
		1492	bgm_volume => 0.25,
		1493	);
		1494
		1495	while (my ($k, $v) = each %DEF_CFG) {
		1496	$CFG->{$k} = $v unless exists $CFG->{$k};
		1497	}
		1498
		1499	sdl_init;
		1500
		1501	@SDL_MODES = reverse
		1502	grep $_->[0] >= 640 && $_->[1] >= 480,
		1503	CFClient::SDL_ListModes;
		1504
		1505	@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
		1506
		1507	$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
		1508
		1509	{
		1510	my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
		1511	DejaVuSans.ttf
		1512	DejaVuSansMono.ttf
		1513	DejaVuSans-Bold.ttf
		1514	DejaVuSansMono-Bold.ttf
		1515	DejaVuSans-Oblique.ttf
		1516	DejaVuSansMono-Oblique.ttf
		1517	DejaVuSans-BoldOblique.ttf
		1518	DejaVuSansMono-BoldOblique.ttf
		1519	);
		1520
785	CFClient::add_font $_ for @fonts;	1521	CFClient::add_font $_ for @fonts;
786	CFClient::set_font $fonts[0];	1522
		1523	$FONT_PROP = new_from_file CFClient::Font $fonts[0];
		1524	$FONT_FIXED = new_from_file CFClient::Font $fonts[1];
		1525
		1526	$FONT_PROP->make_default;
		1527	}
		1528
		1529	video_init;
		1530	audio_init;
787	}	1531	}
788		1532
789	Event::loop;	1533	Event::loop;
790		1534
		1535	END { CFClient::SDL_Quit }
791		1536
		1537	=head1 pclient - Crossfire+ and Crossfire game client
		1538
		1539	Pclient is a Crossfire+ and Crossfire game client.
		1540
		1541	=head2 Features
		1542
		1543	=over 4
		1544
		1545	=item Fullscreen Map
		1546
		1547	PClient can uses a fullscreen map, which greatly enhances how much of the
		1548	game world you can see.
		1549
		1550	=item Persistent Map Cache (Crossfire+ only)
		1551
		1552	PClient can persistently cache all map data it received from the
		1553	server. This not only allows it to display an overview map, but also
		1554	ensures that once-explored areas will be available the next time you want
		1555	to explore more.
		1556
		1557	=item Hardware acceleration
		1558
		1559	Unlike most Crossfire clients, PClient take advantage of OpenGL hardware
		1560	acceleration. Most modern graphics cards have difficulties with 2D
		1561	acceleration, while 3D graphics is accelerated well.
		1562
		1563	=item No arbitrary limits
		1564
		1565	Unlike other Crossfire clients, pclient does not suffer from arbitrary
		1566	limits (like a fixed amount of face numbers). There are still limits, but
		1567	they are not arbitrarily low :)
		1568
		1569	=back
		1570
		1571	=head1 USAGE
		1572
		1573	=head2 The Map
		1574
		1575	The map is always displayed in the background, behind all other windows and UI elements.
		1576
		1577	#TODO# middle-click scrolls
		1578	#
		1579	# keys:
		1580	#
		1581	# a apply
		1582	# keypad moves, kp_5 applies ranged attack to self
		1583
		1584	Starting to type enters the I<completion mode>. In that mode, you can type
		1585	abbreviations or commands and have them executed as soon as they match a
		1586	valid command. This is best explained by a few examples:
		1587
		1588	Typing B<climb> will display a list of commands with I<climb> in their
		1589	name, such as I<ready_skill climbing> and I<use_skill climbing>.
		1590
		1591	You can abbreviate commands by typing only the first character of every
		1592	word. For example, typing I<iwor> will likely select I<invoke word of
		1593	recall>, while I<ccfo> will select I<cast create food>. Likewise, I<rscli>
		1594	will likely select I<ready_skill climbing> and I<usl> will give you
		1595	I<use_skill levitation>.
		1596
		1597	=head2 The map overview
		1598
		1599	#TODO#
		1600
		1601	=head2 The Status area in the lower right corner
		1602
		1603	#TODO#
		1604
		1605	=head2 The I<Statistics>/I>Stats> window
		1606
		1607	#TODO#
		1608
		1609	=head1 FAQ
		1610
		1611	=over 4
		1612
		1613	=item The client is very sluggish and slow, what can I do about this?
		1614
		1615	Most likely, you don't have accelerated OpenGL support. Try to find a
		1616	newer driver, or a driver from your hardware vendor, that features OpenGL
		1617	support.
		1618
		1619	If this is not an option, the following Setup options reduce the load and
		1620	will likely make the client playable with sofwtare rendering (it will
		1621	still be slow, though):
		1622
		1623	=over 4
		1624
		1625	=item B<Video Mode> should be set as low as possible (e.g. 640x480)
		1626
		1627	=item Enable B<Fast & Ugly> mode
		1628
		1629	=item Disable B<Fog of War>
		1630
		1631	=item Increase B<Map Scale>
		1632
		1633	=back
		1634
		1635	=back
		1636
		1637	=head1 AUTHOR
		1638
		1639	Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
		1640
		1641
		1642

Diff Legend

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