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

Diff Legend

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