ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/pclient
(Generate patch)

Comparing deliantra/Deliantra-Client/bin/pclient (file contents):
Revision 1.151 by root, Thu Apr 20 07:27:11 2006 UTC vs.
Revision 1.187 by root, Tue Apr 25 12:56:34 2006 UTC

1#!/opt/bin/perl 1#!/opt/bin/perl
2 2
3use strict; 3use strict;
4use utf8; 4use utf8;
5
6BEGIN {
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
27unshift @INC, $ENV{PAR_TEMP};
5 28
6use Time::HiRes 'time'; 29use Time::HiRes 'time';
7use Event; 30use Event;
8 31
9use Crossfire; 32use Crossfire;
… …
12use Compress::LZF; 35use Compress::LZF;
13 36
14use CFClient; 37use CFClient;
15use CFClient::UI; 38use CFClient::UI;
16use CFClient::MapWidget; 39use CFClient::MapWidget;
40
41$Event::DIED = sub {
42 CFClient::error $_[1];
43};
44
45#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#
17 46
18our $VERSION = '0.1'; 47our $VERSION = '0.1';
19 48
20my $MAX_FPS = 60; 49my $MAX_FPS = 60;
21my $MIN_FPS = 5; # unused as of yet 50my $MIN_FPS = 5; # unused as of yet
… …
37our $WIDTH; 66our $WIDTH;
38our $HEIGHT; 67our $HEIGHT;
39our $FULLSCREEN; 68our $FULLSCREEN;
40our $FONTSIZE; 69our $FONTSIZE;
41 70
71our $FONT_PROP;
72our $FONT_FIXED;
73
42our $MAP; 74our $MAP;
75our $MAPMAP;
43our $MAPWIDGET; 76our $MAPWIDGET;
44our $BUTTONBAR; 77our $BUTTONBAR;
45our $LOGVIEW; 78our $LOGVIEW;
46our $CONSOLE; 79our $CONSOLE;
47our $METASERVER; 80our $METASERVER;
48 81
82our $FLOORBOX;
49our $GAUGES; 83our $GAUGES;
84our $STATWIDS;
50 85
51our $SDL_ACTIVE; 86our $SDL_ACTIVE;
52our %SDL_CB; 87our %SDL_CB;
53 88
54our $SDL_MIXER; 89our $SDL_MIXER;
… …
116 $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value; 151 $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
117 $mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]}); 152 $mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]});
118 }); 153 });
119 $mode_slider->emit (changed => $mode_slider->{range}[0]); 154 $mode_slider->emit (changed => $mode_slider->{range}[0]);
120 155
156 my $row = 1;
157
121 $table->add (0, 1, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen"); 158 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
122 $table->add (1, 1, new CFClient::UI::CheckBox state => $CFG->{fullscreen}, connect_changed => sub { 159 $table->add (1, $row++, new CFClient::UI::CheckBox
160 state => $CFG->{fullscreen},
161 tooltip => "Bring the client into fullscreen mode",
162 connect_changed => sub {
123 my ($self, $value) = @_; 163 my ($self, $value) = @_;
124 $CFG->{fullscreen} = $value; 164 $CFG->{fullscreen} = $value;
165 }
125 }); 166 );
126 167
127 $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly"); 168 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
128 $table->add (1, 2, new CFClient::UI::CheckBox state => $CFG->{fast}, connect_changed => sub { 169 $table->add (1, $row++, new CFClient::UI::CheckBox
170 state => $CFG->{fast},
171 tooltip => "Lower the visual quality considerably to speed up rendering.",
172 connect_changed => sub {
129 my ($self, $value) = @_; 173 my ($self, $value) = @_;
130 $CFG->{fast} = $value; 174 $CFG->{fast} = $value;
175 }
131 }); 176 );
132 177
178 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale");
179 $table->add (1, $row++, new CFClient::UI::Slider
180 range => [$CFG->{map_scale}, 0.25, 2, 0.05],
181 tooltip => "Enlarge or shrink the displayed map",
182 connect_changed => sub {
183 my ($self, $value) = @_;
184 $CFG->{map_scale} = 0.05 * int $value / 0.05;
185 }
186 );
187
133 $table->add (0, 3, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War"); 188 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
134 $table->add (1, 3, new CFClient::UI::CheckBox state => $CFG->{fow_enable}, connect_changed => sub { 189 $table->add (1, $row++, new CFClient::UI::CheckBox
190 state => $CFG->{fow_enable},
191 tooltip => "Fog-of-War marks areas that cannot be seen by the player",
192 connect_changed => sub {
135 my ($self, $value) = @_; 193 my ($self, $value) = @_;
136 $CFG->{fow_enable} = $value; 194 $CFG->{fow_enable} = $value;
195 }
137 }); 196 );
138 197
139 $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity"); 198 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
140 $table->add (1, 4, new CFClient::UI::Slider range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001], connect_changed => sub { 199 $table->add (1, $row++, new CFClient::UI::Slider
200 range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001],
201 tooltip => "The higher the intensity, the lighter the Fog-of-War color",
202 connect_changed => sub {
141 my ($self, $value) = @_; 203 my ($self, $value) = @_;
142 $CFG->{fow_intensity} = $value; 204 $CFG->{fow_intensity} = $value;
205 }
143 }); 206 );
144 207
145 $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth"); 208 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
146 $table->add (1, 5, new CFClient::UI::CheckBox state => $CFG->{fow_smooth}, connect_changed => sub { 209 $table->add (1, $row++, new CFClient::UI::CheckBox
210 state => $CFG->{fow_smooth},
211 tooltip => "Smooth the Fog-of-War a bit to make it more realistic",
212 connect_changed => sub {
147 my ($self, $value) = @_; 213 my ($self, $value) = @_;
148 $CFG->{fow_smooth} = $value; 214 $CFG->{fow_smooth} = $value;
149 status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2; 215 status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2;
216 }
150 }); 217 );
151 218
152 $table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize"); 219 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
153 $table->add (1, 6, new CFClient::UI::Slider range => [$CFG->{gui_fontsize}, 0.7, 1.7, 0.1], connect_changed => sub { 220 $table->add (1, $row++, new CFClient::UI::Slider
221 range => [$CFG->{gui_fontsize}, 0.5, 2, 0.1],
222 tooltip => "The font size used by most GUI elements",
223 connect_changed => sub {
154 $CFG->{gui_fontsize} = 0.1 * int $_[1] * 10; 224 $CFG->{gui_fontsize} = 0.1 * int $_[1] * 10;
155# $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize}; 225# $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
226 }
156 }); 227 );
157 228
158 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Server Log Fontsize"); 229 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Server Log Fontsize");
159 $table->add (1, 7, new CFClient::UI::Slider range => [$CFG->{log_fontsize}, 0.7, 1.7, 0.1], connect_changed => sub { 230 $table->add (1, $row++, new CFClient::UI::Slider
231 range => [$CFG->{log_fontsize}, 0.5, 2, 0.1],
232 tooltip => "The font size used by the server log window only",
233 connect_changed => sub {
160 $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = 0.1 * int $_[1] * 10); 234 $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = 0.1 * int $_[1] * 10);
235 }
161 }); 236 );
162 237
163 $table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Apply", connect_activate => sub { 238 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
239
240 $table->add (1, $row++, new CFClient::UI::Slider
241 range => [$CFG->{stat_fontsize}, 0.5, 2, 0.1],
242 tooltip => "The font size used by the statistics window only",
243 connect_changed => sub {
244 $CFG->{stat_fontsize} = 0.1 * int $_[1] * 10;
245 &set_stats_window_fontsize;
246 }
247 );
248
249 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size");
250 $table->add (1, $row++, new CFClient::UI::Slider
251 range => [$CFG->{gauge_size}, 0.2, 0.8, 0.02],
252 tooltip => "Adjust the size of the stats gauges at the bottom right",
253 connect_changed => sub {
254 $CFG->{gauge_size} = $_[1];
255 my $h = int $HEIGHT * $CFG->{gauge_size};
256 $GAUGES->{win}->set_size ($WIDTH, $h);
257 $GAUGES->{win}->move (0, $HEIGHT - $h);
258 }
259 );
260
261 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
262 $table->add (1, $row++, new CFClient::UI::Slider
263 range => [$CFG->{gauge_fontsize}, 0.5, 2.0, 0.1],
264 tooltip => "Adjusts the fontsize of the gauges at the bottom right",
265 connect_changed => sub {
266 $CFG->{gauge_fontsize} = 0.1 * int $_[1] * 10;
267 &set_gauge_window_fontsize;
268 }
269 );
270
271 $table->add (1, $row++, new CFClient::UI::Button
272 expand => 1, align => 0, text => "Apply",
273 tooltip => "Apply the video settings",
274 connect_activate => sub {
164 video_shutdown (); 275 video_shutdown ();
165 video_init (); 276 video_init ();
277 }
166 }); 278 );
167 279
168 $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable"); 280 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");
169 $table->add (1, 9, new CFClient::UI::CheckBox state => $CFG->{audio_enable}, connect_changed => sub { 281 $table->add (1, $row++, new CFClient::UI::CheckBox
282 state => $CFG->{audio_enable},
283 tooltip => "If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.",
284 connect_changed => sub {
170 $CFG->{audio_enable} = $_[1]; 285 $CFG->{audio_enable} = $_[1];
286 }
171 }); 287 );
172# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume"); 288# $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume");
173# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], connect_changed => sub { 289# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], connect_changed => sub {
174# $CFG->{effects_volume} = $_[1]; 290# $CFG->{effects_volume} = $_[1];
175# }); 291# });
176 $table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music"); 292 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");
177 $table->add (1, 10, my $hbox = new CFClient::UI::HBox); 293 $table->add (1, $row++, my $hbox = new CFClient::UI::HBox);
178 $hbox->add (new CFClient::UI::CheckBox expand => 1, state => $CFG->{bgm_enable}, connect_changed => sub { 294 $hbox->add (new CFClient::UI::CheckBox
295 expand => 1, state => $CFG->{bgm_enable},
296 tooltip => "Enable background music playing",
297 connect_changed => sub {
179 $CFG->{bgm_enable} = $_[1]; 298 $CFG->{bgm_enable} = $_[1];
299 }
180 }); 300 );
181 $hbox->add (new CFClient::UI::Slider expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0.1], connect_changed => sub { 301 $hbox->add (new CFClient::UI::Slider
302 expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0.1],
303 tooltip => "The volume of the background music",
304 connect_changed => sub {
182 $CFG->{bgm_volume} = $_[1]; 305 $CFG->{bgm_volume} = $_[1];
183 CFClient::MixMusic::volume $_[1] * 128; 306 CFClient::MixMusic::volume $_[1] * 128;
307 }
184 }); 308 );
185 309
186 $table->add (1, 11, new CFClient::UI::Button expand => 1, align => 0, text => "Apply", connect_activate => sub { 310 $table->add (1, $row++, new CFClient::UI::Button
311 expand => 1, align => 0, text => "Apply",
312 tooltip => "Apply the audio settings",
313 connect_activate => sub {
187 audio_shutdown (); 314 audio_shutdown ();
188 audio_init (); 315 audio_init ();
316 }
189 }); 317 );
190 318
191 $dialog 319 $dialog
320}
321
322sub set_stats_window_fontsize {
323 for (values %{$STATWIDS}) {
324 $_->set_fontsize ($::CFG->{stat_fontsize});
325 }
326}
327
328sub set_gauge_window_fontsize {
329 for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {
330 $_->set_fontsize ($::CFG->{gauge_fontsize});
331 }
332
333# local $GAUGES->{win}{parent};#d#
334# use PApp::Util; open D, ">:utf8", "d"; print D PApp::Util::dumpval $GAUGES->{win}; close D;
335}
336
337sub make_gauge_window {
338 my $gh = int ($HEIGHT * $CFG->{gauge_size});
339# my $gw = int ($WIDTH * $CFG->{gauge_w_size});
340
341 my $win = new CFClient::UI::Frame (
342 y => $HEIGHT - $gh, x => 0, user_w => $WIDTH, user_h => $gh
343 );
344 $win->add (my $hbox = new CFClient::UI::HBox
345 children => [
346 (new CFClient::UI::HBox expand => 1),
347 ($FLOORBOX = new CFClient::UI::VBox),
348 (my $vbox = new CFClient::UI::VBox),
349 ],
350 );
351
352 $vbox->add (new CFClient::UI::HBox
353 expand => 1,
354 children => [
355 (new CFClient::UI::Empty expand => 1),
356 (my $hb = new CFClient::UI::HBox),
357 ],
358 );
359
360 $hb->add (my $hg = new CFClient::UI::Gauge type => 'hp',
361 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.");
362 $hb->add (my $mg = new CFClient::UI::Gauge type => 'mana',
363 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.");
364 $hb->add (my $gg = new CFClient::UI::Gauge type => 'grace',
365 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.");
366 $hb->add (my $fg = new CFClient::UI::Gauge type => 'food',
367 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.");
368
369 $vbox->add (my $exp = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
370 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.");
371 $vbox->add (my $rng = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
372 tooltip => "Ranged attack - how you attack when you press shift-cursor (spell, skill, weapon etc.)");
373
374 $GAUGES = {
375 exp => $exp, win => $win, range => $rng,
376 food => $fg, mana => $mg, hp => $hg, grace => $gg
377 };
378
379 &set_gauge_window_fontsize;
380
381 $win
382}
383
384sub make_stats_window {
385 my $tgw = new CFClient::UI::FancyFrame x => $WIDTH * 2/5, y => 0, title => "Stats";
386
387 $tgw->add (new CFClient::UI::Window child => my $vb = new CFClient::UI::VBox);
388 $vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1);
389 $vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1);
390
391 $vb->add (my $hb = new CFClient::UI::HBox expand => 1);
392
393 $hb->add (my $tbl = new CFClient::UI::Table expand => 1);
394
395 my $black = [0, 0, 0];
396
397 for (
398 [0, 0, st_str => "Str", 30, "Physical Strength, determines damage dealt with weapons, how much you can carry, and how often you can attack"],
399 [0, 1, st_dex => "Dex", 30, "Dexterity, your physical agility. Determines chance of being hit and affects armor class and speed"],
400 [0, 2, st_con => "Con", 30, "Constitution, physical health and toughness. Determines how many healthpoints you can have"],
401 [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"],
402 [0, 4, st_wis => "Wis", 30, "Wisdom, the ability to learn and use divine magic (prayers). Determines how many grace points you can have"],
403 [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"],
404 [0, 6, st_cha => "Cha", 30, "Charisma, how well you are received by NPCs. Affects buying and selling prices in shops."],
405
406 [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."],
407 [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."],
408 [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."],
409 [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."],
410 [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."],
411 [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."],
412 ) {
413 my ($col, $row, $id, $label, $template, $tooltip) = @$_;
414
415 $tbl->add ($col , $row, $STATWIDS->{$id} = new CFClient::UI::Label
416 font => $FONT_FIXED, can_hover => 1, can_events => 1, valign => 0, align => +1, template => $template, tooltip => $tooltip);
417 $tbl->add ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFClient::UI::Label
418 font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $black, valign => 0, align => -1, text => $label, tooltip => $tooltip);
419 }
420
421 $hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);
422
423 my $row = 0;
424 my $col = 0;
425
426 my %resist_names = (
427 slow => "Slow",
428 holyw => "Holy Word",
429 conf => "Confusion",
430 fire => "Fire",
431 depl => "Depletion (some monsters and other effects can cause stats depletion)",
432 magic => "Magic",
433 drain => "Draining (some monsters (e.g. vampires) and other effects can steal experience)",
434 acid => "Acid",
435 pois => "Poison",
436 para => "Paralysation",
437 deat => "Death (resistance against death spells)",
438 phys => "Physical",
439 blind => "Blind",
440 fear => "Fear",
441 tund => "Turn undead",
442 elec => "Electricity",
443 cold => "Cold",
444 ghit => "Ghost hit (special attack used by ghosts and ghost-like beings)",
445 );
446 for (qw/slow holyw conf fire depl magic
447 drain acid pois para deat phys
448 blind fear tund elec cold ghit/)
449 {
450 $tbl2->add ($col, $row,
451 $STATWIDS->{"res_$_"} =
452 new CFClient::UI::Label
453 font => $FONT_FIXED,
454 template => "-100%",
455 align => +1,
456 valign => 0,
457 can_events => 1,
458 can_hover => 1,
459 tooltip => $resist_names{$_},
460 );
461 $tbl2->add ($col + 1, $row, new CFClient::UI::Image
462 font => $FONT_FIXED,
463 can_hover => 1,
464 can_events => 1,
465 image => "ui/resist/resist_$_.png",
466 tooltip => $resist_names{$_},
467 );
468
469 $row++;
470 if ($row % 6 == 0) {
471 $col += 2;
472 $row = 0;
473 }
474 }
475
476 &set_stats_window_fontsize;
477 update_stats_window ({});
478
479 $tgw
480}
481
482sub formsep {
483 reverse join ",", grep length, split /(...)/, reverse $_[0] * 1
484}
485
486sub update_stats_window {
487 my ($stats) = @_;
488
489 # i love text protocols!!!
490 my $hp = $stats->{Crossfire::Protocol::CS_STAT_HP} * 1;
491 my $hp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXHP} * 1;
492 my $sp = $stats->{Crossfire::Protocol::CS_STAT_SP} * 1;
493 my $sp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXSP} * 1;
494 my $fo = $stats->{Crossfire::Protocol::CS_STAT_FOOD} * 1;
495 my $fo_m = 999;
496 my $gr = $stats->{Crossfire::Protocol::CS_STAT_GRACE} * 1;
497 my $gr_m = $stats->{Crossfire::Protocol::CS_STAT_MAXGRACE} * 1;
498
499 $GAUGES->{hp} ->set_value ($hp, $hp_m);
500 $GAUGES->{mana} ->set_value ($sp, $sp_m);
501 $GAUGES->{food} ->set_value ($fo, $fo_m);
502 $GAUGES->{grace} ->set_value ($gr, $gr_m);
503 $GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::CS_STAT_EXP64})
504 . " (lvl " . ($stats->{Crossfire::Protocol::CS_STAT_LEVEL} * 1) . ")");
505 my $rng = $stats->{Crossfire::Protocol::CS_STAT_RANGE};
506 $rng =~ s/^Range: //; # thank you so much dear server
507 $GAUGES->{range} ->set_text ("Rng: " . $rng);
508 my $title = $stats->{Crossfire::Protocol::CS_STAT_TITLE};
509 $title =~ s/^Player: //;
510 $STATWIDS->{title} ->set_text ("Title: " . $title);
511
512 $STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5});
513 $STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8});
514 $STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9});
515 $STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6});
516 $STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7});
517 $STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22});
518 $STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10});
519 $STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13});
520 $STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14});
521 $STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15});
522 $STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16});
523 $STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_SPEED});
524 $STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_WEAP_SP});
525
526 my %tbl = (
527 phys => 100,
528 magic => 101,
529 fire => 102,
530 elec => 103,
531 cold => 104,
532 conf => 105,
533 acid => 106,
534 drain => 107,
535 ghit => 108,
536 pois => 109,
537 slow => 110,
538 para => 111,
539 tund => 112,
540 fear => 113,
541 depl => 113,
542 deat => 115,
543 holyw => 116,
544 blind => 117
545 );
546
547 for (keys %tbl) {
548 $STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}});
549 }
550
192} 551}
193 552
194sub metaserver_dialog { 553sub metaserver_dialog {
195 my $dialog = new CFClient::UI::FancyFrame 554 my $dialog = new CFClient::UI::FancyFrame
196 title => "Metaserver", 555 title => "Metaserver",
… …
199 $vbox->add ($dialog->{table} = new CFClient::UI::Table); 558 $vbox->add ($dialog->{table} = new CFClient::UI::Table);
200 559
201 $dialog 560 $dialog
202} 561}
203 562
563my $METASERVER_ATIME;
564
204sub update_metaserver { 565sub update_metaserver {
205 my ($HOST) = @_; 566 my ($HOST) = @_;
206 567
207 status "fetching metaserver list..."; 568 return if $METASERVER_ATIME > time;
569 $METASERVER_ATIME = time + 60;
570
571 my $table = $METASERVER->{table};
572 $table->clear;
573 $table->add (0, 0, my $label = new CFClient::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
208 574
209 my $buf; 575 my $buf;
210 576
211 my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0; 577 my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;
578
579 unless ($fh) {
580 $label->set_text ("unable to contact metaserver: $!");
581 return;
582 }
212 583
213 Event->io (fd => $fh, poll => 'r', cb => sub { 584 Event->io (fd => $fh, poll => 'r', cb => sub {
214 my $res = sysread $fh, $buf, 8192, length $buf; 585 my $res = sysread $fh, $buf, 8192, length $buf;
215 586
216 if (!defined $res) { 587 if (!defined $res) {
217 $_[0]->w->cancel; 588 $_[0]->w->cancel;
218 status "metaserver: $!"; 589 $label->set_text ("error while retrieving server list: $!");
219 } elsif ($res == 0) { 590 } elsif ($res == 0) {
220 $_[0]->w->cancel; 591 $_[0]->w->cancel;
221 status "server list retrieved"; 592 status "server list retrieved";
222 593
223 my $table = $METASERVER->{table}; 594 utf8::decode $buf if utf8::valid $buf;
224 595
225 $table->clear; 596 $table->clear;
226 597
227 my @col = qw(Use #Users Host Uptime Version Description); 598 my @col = qw(Use #Users Host Uptime Version Description);
228 $table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_]) 599 $table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])
… …
252 $m = [$users, $host, $uptime, $version, $desc]; 623 $m = [$users, $host, $uptime, $version, $desc];
253 624
254 $y++; 625 $y++;
255 626
256 $table->add (0, $y, new CFClient::UI::VBox children => [ 627 $table->add (0, $y, new CFClient::UI::VBox children => [
257 (new CFClient::UI::Button text => " ", connect_activate => sub { 628 (new CFClient::UI::Button text => "Use", connect_activate => sub {
258 $HOST->set_text ($CFG->{host} = $host); 629 $HOST->set_text ($CFG->{host} = $host);
259 }), 630 }),
260 (new CFClient::UI::Empty expand => 1), 631 (new CFClient::UI::Empty expand => 1),
261 ]); 632 ]);
262 633
… …
276 $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port"); 647 $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port");
277 648
278 { 649 {
279 $table->add (1, 2, my $vbox = new CFClient::UI::VBox); 650 $table->add (1, 2, my $vbox = new CFClient::UI::VBox);
280 651
281 $vbox->add (my $HOST = new CFClient::UI::Entry expand => 1, text => $CFG->{host}, connect_changed => sub { 652 $vbox->add (
653 my $HOST = new CFClient::UI::Entry
654 expand => 1,
655 text => $CFG->{host},
656 tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
657 connect_changed => sub {
658 my ($self, $value) = @_;
659 $CFG->{host} = $value;
660 }
661 );
662
663 $METASERVER = metaserver_dialog;
664
665 $vbox->add (new CFClient::UI::Flopper
666 expand => 1,
667 text => "Metaserver",
668 other => $METASERVER,
669 tooltip => "Show a list of avaible crossfire servers",
670 connect_open => sub {
671 update_metaserver $HOST;
672 }
673 );
674 }
675
676 $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
677 $table->add (1, 4, new CFClient::UI::Entry
678 text => $CFG->{user},
679 tooltip => "The name of your character on the server",
680 connect_changed => sub {
282 my ($self, $value) = @_; 681 my ($self, $value) = @_;
283 $CFG->{host} = $value;
284 });
285
286 $METASERVER = metaserver_dialog;
287
288 $vbox->add (new CFClient::UI::Flopper expand => 1, text => "Metaserver", other => $METASERVER, connect_open => sub {
289 update_metaserver $HOST;
290 });
291 }
292
293 $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username");
294 $table->add (1, 4, new CFClient::UI::Entry text => $CFG->{user}, connect_changed => sub {
295 my ($self, $value) = @_;
296 $CFG->{user} = $value; 682 $CFG->{user} = $value;
683 }
297 }); 684 );
298 685
299 $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password"); 686 $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password");
300 $table->add (1, 5, new CFClient::UI::Entry text => $CFG->{password}, hidden => 1, connect_changed => sub { 687 $table->add (1, 5, new CFClient::UI::Entry
688 text => $CFG->{password},
689 hidden => 1,
690 tooltip => "The password for your character",
691 connect_changed => sub {
301 my ($self, $value) = @_; 692 my ($self, $value) = @_;
302 $CFG->{password} = $value; 693 $CFG->{password} = $value;
694 }
303 }); 695 );
304 696
305 $table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "Def. say cmd"); 697 $table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "Def. say cmd");
306 $table->add (1, 6, my $saycmd = new CFClient::UI::Entry text => $CFG->{say_command}, connect_changed => sub { 698 $table->add (1, 6, my $saycmd = new CFClient::UI::Entry
699 text => $CFG->{say_command},
700 tooltip => "This is the command that will be used if you write a line in the message window entry. "
701 ."Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
702 ."But you could also set it to 'tell &lt;playername&gt;' to only chat with that user.",
703 connect_changed => sub {
307 my ($self, $value) = @_; 704 my ($self, $value) = @_;
308 $CFG->{say_command} = $value; 705 $CFG->{say_command} = $value;
706 }
309 }); 707 );
310 708
311 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size"); 709 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
312 $table->add (1, 7, new CFClient::UI::Slider 710 $table->add (1, 7, new CFClient::UI::Slider
313 req_w => 100, 711 req_w => 100,
314 range => [$CFG->{mapsize}, 10, 100 + 1, 1], 712 range => [$CFG->{mapsize}, 10, 100 + 1, 1],
713 tooltip => "This is the size of the portion of the map update the server sends you. "
714 ."If you set this to a high value you will be able to see further for example.",
315 connect_changed => sub { 715 connect_changed => sub {
316 my ($self, $value) = @_; 716 my ($self, $value) = @_;
317 717
318 $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 718 $CFG->{mapsize} = $self->{range}[0] = $value = int $value;
319 }, 719 },
… …
327} 727}
328 728
329sub message_window { 729sub message_window {
330 my $window = new CFClient::UI::FancyFrame 730 my $window = new CFClient::UI::FancyFrame
331 title => "Messages", 731 title => "Messages",
332 border_bg => [1, 1, 1, 0.5], 732 border_bg => [1, 1, 1, 1],
333 bg => [0.3, 0.3, 0.3, 0.8], 733 bg => [0, 0, 0, 0.5],
334 user_w => int $::WIDTH / 3, 734 user_w => int $::WIDTH / 3,
335 user_h => int $::HEIGHT / 5, 735 user_h => int $::HEIGHT / 5,
336 child => (my $vbox = new CFClient::UI::VBox); 736 child => (my $vbox = new CFClient::UI::VBox);
337 737
338 $vbox->add ($LOGVIEW = new CFClient::UI::TextView 738 $vbox->add ($LOGVIEW = new CFClient::UI::TextView
339 expand => 1, 739 expand => 1,
740 font => $FONT_FIXED,
340 fontsize => $::CFG->{log_fontsize}, 741 fontsize => $::CFG->{log_fontsize},
341 ); 742 );
342 743
343 $vbox->add (my $input = new CFClient::UI::Entry 744 $vbox->add (my $input = new CFClient::UI::Entry
344 connect_focus_in => sub { 745 connect_focus_in => sub {
… …
417 fontsize => 0.8, 818 fontsize => 0.8,
418 markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode"; 819 markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode";
419 $ALT_ENTER_MESSAGE->show; 820 $ALT_ENTER_MESSAGE->show;
420 $ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h}); 821 $ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h});
421 822
422 $CFClient::UI::ROOT->add ($MAPWIDGET = new CFClient::MapWidget); 823 CFClient::UI::FancyFrame->new (
423 $MAPWIDGET->focus_in; 824 border_bg => [1, 1, 1, 192/255],
825 bg => [1, 1, 1, 0],
826 child => $MAPMAP = new CFClient::MapWidget::MapMap
827 )->show;
828
829 $MAPWIDGET = new CFClient::MapWidget;
424 $MAPWIDGET->connect (activate_console => sub { 830 $MAPWIDGET->connect (activate_console => sub {
425 my ($mapwidget, $preset) = @_; 831 my ($mapwidget, $preset) = @_;
426 832
427 if ($CONSOLE) { 833 if ($CONSOLE) {
428 $CONSOLE->{input}->{auto_activated} = 1; 834 $CONSOLE->{input}->{auto_activated} = 1;
… …
431 if ($preset && $CONSOLE->{input}->get_text eq '') { 837 if ($preset && $CONSOLE->{input}->get_text eq '') {
432 $CONSOLE->{input}->set_text ($preset); 838 $CONSOLE->{input}->set_text ($preset);
433 } 839 }
434 } 840 }
435 }); 841 });
842 $MAPWIDGET->show;
843 $MAPWIDGET->focus_in;
436 844
437 $CFClient::UI::ROOT->add ($BUTTONBAR = new CFClient::UI::HBox); 845 $BUTTONBAR = new CFClient::UI::HBox;
438 846
439 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup); 847 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup);
440 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup); 848 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup);
441 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window); 849 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);
850
851 $CFClient::UI::ROOT->add (make_gauge_window); # 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
852 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window);
442 853
443 $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub { 854 $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {
444 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc"; 855 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
445 status "Configuration Saved"; 856 status "Configuration Saved";
446 }); 857 });
447 858
859 $BUTTONBAR->show;
860
448 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup 861 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
449
450 my $tgw = new CFClient::UI::FancyFrame (x => $WIDTH - 300, y => 0, title => "Stats");
451 $tgw->add (my $hbox = new CFClient::UI::HBox ());
452
453 $hbox->add (my $hg = new CFClient::UI::Gauge (type => 'hp'));
454 $hbox->add (my $mg = new CFClient::UI::Gauge (type => 'mana'));
455 $hbox->add (my $gg = new CFClient::UI::Gauge (type => 'grace'));
456 $hbox->add (my $fg = new CFClient::UI::Gauge (type => 'food'));
457
458 $GAUGES = { food => $fg, mana => $mg, hp => $hg, grace => $gg };
459 $CFClient::UI::ROOT->add ($tgw);
460} 862}
461 863
462sub video_shutdown { 864sub video_shutdown {
463 $CFClient::UI::ROOT->{children} = []; 865 $CFClient::UI::ROOT->{children} = [];
866 undef $CFClient::UI::GRAB;
867 undef $CFClient::UI::HOVER;
464 undef $SDL_ACTIVE; 868 undef $SDL_ACTIVE;
465} 869}
466 870
871my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
467my $bgmusic;#TODO#hack#d# 872my $bgmusic;#TODO#hack#d#
873
874sub audio_music_finished {
875 return unless $CFG->{bgm_enable};
876
877 # TODO: hack, do play loop and mood music
878 $bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/$bgmusic[0]";
879 $bgmusic->play (0);
880
881 push @bgmusic, shift @bgmusic;
882}
468 883
469sub audio_init { 884sub audio_init {
470 if ($CFG->{audio_enable}) { 885 if ($CFG->{audio_enable}) {
471 if (open my $fh, "<:utf8", CFClient::find_rcfile "sounds/config") { 886 if (open my $fh, "<:utf8", CFClient::find_rcfile "sounds/config") {
472
473 $SDL_MIXER = !CFClient::Mix_OpenAudio; 887 $SDL_MIXER = !CFClient::Mix_OpenAudio;
474 CFClient::Mix_AllocateChannels 8; 888 CFClient::Mix_AllocateChannels 8;
475 CFClient::MixMusic::volume $CFG->{bgm_volume} * 128; 889 CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
476 890
477 # TODO: hack, do play loop and mood music 891 audio_music_finished;
478 if ($CFG->{bgm_enable}) {
479 $bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/game3.ogg";
480 $bgmusic->play;
481 }
482 892
483 while (<$fh>) { 893 while (<$fh>) {
484 next if /^\s*#/; 894 next if /^\s*#/;
485 next if /^\s*$/; 895 next if /^\s*$/;
486 896
… …
564@conn::ISA = Crossfire::Protocol::; 974@conn::ISA = Crossfire::Protocol::;
565 975
566sub conn::stats_update { 976sub conn::stats_update {
567 my ($self, $stats) = @_; 977 my ($self, $stats) = @_;
568 978
569 # i love text protocols!!! 979 update_stats_window ($stats);
570 # FIXME: the stats are somehow weird
571 my $hp = $stats->{1};
572 my $hp_m = $stats->{2};
573 my $sp = $stats->{3};
574 my $sp_m = $stats->{4};
575 my $fo = $stats->{18};
576 my $fo_m = 999;
577 my $gr = $stats->{23};
578 my $gr_m = $stats->{24};
579
580 #d# warn "DATA $hp $hp_m $sp $sp_m $fo $fo_m $gr $gr_m\n";
581 $GAUGES->{hp} ->set_value ($hp, $hp_m);
582 $GAUGES->{mana} ->set_value ($sp, $sp_m);
583 $GAUGES->{food} ->set_value ($fo, $fo_m);
584 $GAUGES->{grace}->set_value ($gr, $gr_m);
585} 980}
586 981
587sub conn::user_send { 982sub conn::user_send {
588 my ($self, $command) = @_; 983 my ($self, $command) = @_;
589 984
… …
614 1009
615 my ($hash, $x, $y, $w, $h) = @$map_info; 1010 my ($hash, $x, $y, $w, $h) = @$map_info;
616 1011
617 my $data = $MAP->get_rect ($x, $y, $w, $h); 1012 my $data = $MAP->get_rect ($x, $y, $w, $h);
618 $MAPCACHE->put ($hash => Compress::LZF::compress $data); 1013 $MAPCACHE->put ($hash => Compress::LZF::compress $data);
619
620 warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d# 1014 #warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d#
621
622} 1015}
623 1016
624sub conn::map_clear { 1017sub conn::map_clear {
625 my ($self) = @_; 1018 my ($self) = @_;
626 1019
… …
634sub conn::load_map($$$) { 1027sub conn::load_map($$$) {
635 my ($self, $hash, $x, $y) = @_; 1028 my ($self, $hash, $x, $y) = @_;
636 1029
637 if (defined (my $data = $MAPCACHE->get ($hash))) { 1030 if (defined (my $data = $MAPCACHE->get ($hash))) {
638 $data = Compress::LZF::decompress $data; 1031 $data = Compress::LZF::decompress $data;
639 warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d# 1032 #warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d#
640 for my $id ($MAP->set_rect ($x, $y, $data)) { 1033 for my $id ($MAP->set_rect ($x, $y, $data)) {
641 my $data = $TILECACHE->get ($id) 1034 my $data = $TILECACHE->get ($id)
642 or next; 1035 or next;
643 1036
644 $self->set_texture ($id => $data); 1037 $self->set_texture ($id => $data);
645 } 1038 }
646 } 1039 }
647} 1040}
648 1041
1042# this method does a "flood fill" into every tile direction
1043# it assumes that tiles are arranged in a rectangular grid,
1044# i.e. a map is the same as the left of the right map etc.
1045# failure to comply are harmless and result in display errors
1046# at worst.
649sub conn::flood_fill { 1047sub conn::flood_fill {
650 my ($self, $gx, $gy, $path, $hash, $flags) = @_; 1048 my ($self, $gx, $gy, $path, $hash, $flags) = @_;
651 1049
652 # the server does not allow map paths > 6 1050 # the server does not allow map paths > 6
653 return if 6 <= length $path; 1051 return if 7 <= length $path;
654 1052
655 my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}}; 1053 my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
656 1054
657 for ( 1055 for (
658 [1, 0, -1], 1056 [1, 0, -1],
… …
701 1099
702 $self->flush_map; 1100 $self->flush_map;
703 1101
704 my ($ox, $oy) = ($::MAP->ox, $::MAP->oy); 1102 my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
705 1103
706 my $mapmapw = 250; 1104 my $mapmapw = $MAPMAP->{w};
707 my $mapmaph = 250; 1105 my $mapmaph = $MAPMAP->{h};
708 1106
709 $self->{neigh_rect} = [ 1107 $self->{neigh_rect} = [
710 $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5, 1108 $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
711 $ox + $mapmapw * 0.5, $oy + $mapmapw * 0.5, 1109 $ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
712 ]; 1110 ];
713 1111
714 delete $self->{neigh_grid}; 1112 delete $self->{neigh_grid};
715 $self->flood_fill (0, 0, "", $hash, $flags); 1113 $self->flood_fill (0, 0, "", $hash, $flags);
716 1114
717 $x += $ox; 1115 $x += $ox;
718 $y += $oy; 1116 $y += $oy;
719 1117
720 $self->{map_info} = [$hash, $x, $y, $w, $h]; 1118 $self->{map_info} = [$hash, $x, $y, $w, $h];
1119
1120 my $map = $self->{map_info}[0];
1121 $map =~ s/^.*?\/([^\/]+)$/\1/;
1122 $STATWIDS->{map}->set_text ("Map: " . $map);
721 1123
722 $self->load_map ($hash, $x, $y); 1124 $self->load_map ($hash, $x, $y);
723} 1125}
724 1126
725sub conn::face_find { 1127sub conn::face_find {
… …
751 } 1153 }
752 1154
753gotid: 1155gotid:
754 $face->{id} = $id; 1156 $face->{id} = $id;
755 $MAP->set_face ($facenum => $id); 1157 $MAP->set_face ($facenum => $id);
1158 $self->{faceid}[$facenum] = $id;#d#
756 $TILECACHE->get ($id) 1159 $TILECACHE->get ($id)
757} 1160}
758 1161
759sub conn::face_update { 1162sub conn::face_update {
760 my ($self, $facenum, $face) = @_; 1163 my ($self, $facenum, $face) = @_;
… …
768 my ($self, $id, $data) = @_; 1171 my ($self, $id, $data) = @_;
769 1172
770 $self->{texture}[$id] ||= do { 1173 $self->{texture}[$id] ||= do {
771 my $tex = 1174 my $tex =
772 new_from_image CFClient::Texture 1175 new_from_image CFClient::Texture
773 $data, minify => 1; 1176 $data, minify => 1, mipmap => 1;
774 1177
775 $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}}); 1178 $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
776 $MAPWIDGET->update; 1179 $MAPWIDGET->update;
777 1180
778 $tex 1181 $tex
… …
790 1193
791 $chunk->play; 1194 $chunk->play;
792# warn "sound $x,$y,$soundnum,$type\n";#d# 1195# warn "sound $x,$y,$soundnum,$type\n";#d#
793} 1196}
794 1197
1198my $LAST_QUERY; # server is stupid, stupid, stupid
1199
795sub conn::query { 1200sub conn::query {
796 my ($self, $flags, $prompt) = @_; 1201 my ($self, $flags, $prompt) = @_;
797 1202
798 #TODO, display dialog with relevant information 1203 $prompt = $LAST_QUERY unless length $prompt;
799 warn "<<<<QUERY:$flags:$prompt>>>\n";#d# 1204 $LAST_QUERY = $prompt;
1205
1206 my $dialog = new CFClient::UI::FancyFrame
1207 title => "Query",
1208 child => my $vbox = new CFClient::UI::VBox;
1209
1210 $vbox->add (new CFClient::UI::Label
1211 max_w => $::WIDTH * 0.4,
1212 text => $prompt);
1213
1214 if ($flags & Crossfire::Protocol::CS_QUERY_YESNO) {
1215 $vbox->add (my $hbox = new CFClient::HBox);
1216 $hbox->add (new CFClient::Button
1217 text => "No",
1218 connect_activate => sub {
1219 $self->send ("reply n");
1220 $dialog->destroy;
1221 $MAPWIDGET->focus_in;
1222 }
1223 );
1224 $hbox->add (new CFClient::Button
1225 text => "Yes",
1226 connect_activate => sub {
1227 $self->send ("reply y");
1228 $dialog->destroy;
1229 $MAPWIDGET->focus_in;
1230 },
1231 );
1232
1233 $dialog->focus_in;
1234
1235 } elsif ($flags & Crossfire::Protocol::CS_QUERY_SINGLECHAR) {
1236 $dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)";
1237 $vbox->add (my $entry = new CFClient::UI::Entry
1238 connect_changed => sub {
1239 $self->send ("reply $_[1]");
1240 $dialog->destroy;
1241 $MAPWIDGET->focus_in;
1242 },
1243 );
1244
1245 $entry->focus_in;
1246
1247 } else {
1248 $dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
1249
1250 $vbox->add (my $entry = new CFClient::UI::Entry
1251 $flags & Crossfire::Protocol::CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (),
1252 connect_activate => sub {
1253 $self->send ("reply $_[1]");
1254 $dialog->destroy;
1255 $MAPWIDGET->focus_in;
1256 },
1257 );
1258
1259 $entry->focus_in;
1260 }
1261
1262 $dialog->show;
800} 1263}
801 1264
802sub conn::drawinfo { 1265sub conn::drawinfo {
803 my ($self, $color, $text) = @_; 1266 my ($self, $color, $text) = @_;
804 1267
… …
822} 1285}
823 1286
824sub conn::spell_add { 1287sub conn::spell_add {
825 my ($self, $spell) = @_; 1288 my ($self, $spell) = @_;
826 1289
1290 # TODO
1291 # create a widget dynamically, using spell face (CF::Protocol downloads them)
827 $MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message}, sub { 1292 $MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message});
828 });
829 $MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message}, sub { 1293 $MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message});
830 });
831} 1294}
832 1295
833sub conn::spell_delete { 1296sub conn::spell_delete {
834 my ($self, $spell) = @_; 1297 my ($self, $spell) = @_;
835} 1298}
836 1299
837sub conn::addme_success { 1300sub conn::addme_success {
838 my ($self) = @_; 1301 my ($self) = @_;
839 1302
840 for my $skill (values %{$self->{skill_info}}) { 1303 for my $skill (values %{$self->{skill_info}}) {
841 $MAPWIDGET->add_command ("ready_skill $skill", "", sub { 1304 $MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'");
1305 $MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'");
1306 }
1307}
1308
1309sub update_floorbox {
1310 $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
1311 $FLOORBOX->clear;
1312 $FLOORBOX->add (new CFClient::UI::Empty expand => 1);
1313
1314 my @items = values %{ $CONN->{container}{0} };
1315
1316 # we basically have to use the same sorting as everybody else
1317 @items = sort { $a->{type} <=> $b->{type} } @items;
1318
1319 for my $item (reverse @items) {
1320 my $desc = $item->{nrof} < 2
1321 ? $item->{name}
1322 : "$item->{nrof} $item->{name_pl}";
1323 # todo: animation widget, face widget, weight(?) etc.
1324 $FLOORBOX->add (my $hbox = new CFClient::UI::HBox
1325 tooltip => (CFClient::UI::Label->escape ($desc)
1326 . "\n<small>leftclick - pick up\nmiddle click - apply\nrightclick - menu</small>"),
1327 can_hover => 1,
1328 can_events => 1,
1329 connect_button_down => sub {
1330 my ($self, $ev, $x, $y) = @_;
1331
1332 # todo: maybe put examine on 1? but should just be a tooltip :(
1333 if ($ev->{button} == 1) {
1334 $CONN->send ("move $CONN->{player}{tag} $item->{tag} 0");
1335 } elsif ($ev->{button} == 2) {
1336 $CONN->send ("apply $item->{tag}");
1337 } elsif ($ev->{button} == 3) {
1338 # examine, lock, mark, maybe other things
1339 warn "MENU not implemented yet\n";
1340 }
1341
1342 1
1343 },
1344 );
1345
1346 $hbox->add (new CFClient::UI::Face
1347 can_events => 0,
1348 face => $item->{face},
1349 anim => $item->{anim},
1350 animspeed => $item->{animspeed},
1351 );
1352
1353 $hbox->add (new CFClient::UI::Label
1354 can_events => 0,
1355 text => $desc,
1356 );
842 }); 1357 }
843 $MAPWIDGET->add_command ("use_skill $skill", "", sub {
844 }); 1358 });
1359 refresh;
1360}
1361
1362sub conn::container_add {
1363 my ($self, $id, $items) = @_;
1364
1365 update_floorbox if $id == 0;
1366 # $self-<{player}{tag} => player inv
1367 #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1368}
1369
1370sub conn::container_clear {
1371 my ($self, $id) = @_;
1372
1373 update_floorbox if $id == 0;
1374# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1375}
1376
1377sub conn::item_delete {
1378 my ($self, @items) = @_;
1379
1380 for (@items) {
1381 update_floorbox if $_->{container} == 0;
845 } 1382 }
1383}
1384
1385sub conn::item_update {
1386 my ($self, $item) = @_;
1387
1388 update_floorbox if $item->{container} == 0;
846} 1389}
847 1390
848%SDL_CB = ( 1391%SDL_CB = (
849 CFClient::SDL_QUIT => sub { 1392 CFClient::SDL_QUIT => sub {
850 Event::unloop -1; 1393 Event::unloop -1;
851 }, 1394 },
852 CFClient::SDL_VIDEORESIZE => sub { 1395 CFClient::SDL_VIDEORESIZE => sub {
853 }, 1396 },
854 CFClient::SDL_VIDEOEXPOSE => sub { 1397 CFClient::SDL_VIDEOEXPOSE => \&refresh,
855 refresh; 1398 CFClient::SDL_ACTIVEEVENT => sub {
1399# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
856 }, 1400 },
857 CFClient::SDL_KEYDOWN => sub { 1401 CFClient::SDL_KEYDOWN => sub {
858 if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) { 1402 if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
859 # alt-enter 1403 # alt-enter
860 video_shutdown; 1404 video_shutdown;
… …
862 video_init; 1406 video_init;
863 } else { 1407 } else {
864 CFClient::UI::feed_sdl_key_down_event ($_[0]); 1408 CFClient::UI::feed_sdl_key_down_event ($_[0]);
865 } 1409 }
866 }, 1410 },
867 CFClient::SDL_KEYUP => sub { 1411 CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
868 CFClient::UI::feed_sdl_key_up_event ($_[0]); 1412 CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
869 }, 1413 CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
870 CFClient::SDL_MOUSEMOTION => sub { 1414 CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
871 CFClient::UI::feed_sdl_motion_event ($_[0]); 1415 CFClient::SDL_USEREVENT => \&audio_music_finished,
872 },
873 CFClient::SDL_MOUSEBUTTONDOWN => sub {
874 CFClient::UI::feed_sdl_button_down_event ($_[0]);
875 },
876 CFClient::SDL_MOUSEBUTTONUP => sub {
877 CFClient::UI::feed_sdl_button_up_event ($_[0]);
878 },
879 CFClient::SDL_ACTIVEEVENT => sub {
880# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
881 },
882); 1416);
883 1417
884############################################################################# 1418#############################################################################
885 1419
886$SIG{INT} = $SIG{TERM} = sub { exit }; 1420$SIG{INT} = $SIG{TERM} = sub { exit };
… …
894 sdl_mode => 0, 1428 sdl_mode => 0,
895 width => 640, 1429 width => 640,
896 height => 480, 1430 height => 480,
897 fullscreen => 0, 1431 fullscreen => 0,
898 fast => 0, 1432 fast => 0,
1433 map_scale => 0.5,
899 fow_enable => 1, 1434 fow_enable => 1,
900 fow_intensity => 0.45, 1435 fow_intensity => 0.45,
901 fow_smooth => 0, 1436 fow_smooth => 0,
902 gui_fontsize => 1, 1437 gui_fontsize => 1,
903 log_fontsize => 14, 1438 log_fontsize => 1,
1439 gauge_fontsize => 1,
1440 gauge_size => 0.35,
1441 stat_fontsize => 1,
904 mapsize => 100, 1442 mapsize => 100,
905 host => "crossfire.schmorp.de", 1443 host => "crossfire.schmorp.de",
906 say_command => 'say', 1444 say_command => 'say',
907 audio_enable => 1, 1445 audio_enable => 1,
908 bgm_enable => 1, 1446 bgm_enable => 1,
… …
922@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)"; 1460@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
923 1461
924$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES; 1462$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
925 1463
926{ 1464{
927 my @fonts = map CFClient::find_rcfile $_, qw(uifont.ttf uifontb.ttf uifonti.ttf uifontbi.ttf); 1465 my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
1466 DejaVuSans.ttf
1467 DejaVuSansMono.ttf
1468 DejaVuSans-Bold.ttf
1469 DejaVuSansMono-Bold.ttf
1470 DejaVuSans-Oblique.ttf
1471 DejaVuSansMono-Oblique.ttf
1472 DejaVuSans-BoldOblique.ttf
1473 DejaVuSansMono-BoldOblique.ttf
1474 );
928 1475
929 CFClient::add_font $_ for @fonts; 1476 CFClient::add_font $_ for @fonts;
930 CFClient::set_font $fonts[0]; 1477
1478 $FONT_PROP = new_from_file CFClient::Font $fonts[0];
1479 $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
1480
1481 $FONT_PROP->make_default;
931} 1482}
932 1483
933video_init; 1484video_init;
934audio_init; 1485audio_init;
935 1486
936Event::loop; 1487Event::loop;
937 1488
938END { CFClient::SDL_Quit } 1489END { CFClient::SDL_Quit }
939 1490
1491=head1 pclient - Crossfire+ and Crossfire game client
940 1492
1493Pclient is a Crossfire+ and Crossfire game client.
1494
1495=head2 Features
1496
1497=over 4
1498
1499=item Fullscreen Map
1500
1501PClient can uses a fullscreen map, which greatly enhances how much of the
1502game world you can see.
1503
1504=item Persistent Map Cache (Crossfire+ only)
1505
1506PClient can persistently cache all map data it received from the
1507server. This not only allows it to display an overview map, but also
1508ensures that once-explored areas will be available the next time you want
1509to explore more.
1510
1511=item Hardware acceleration
1512
1513Unlike most Crossfire clients, PClient take advantage of OpenGL hardware
1514acceleration. Most modern graphics cards have difficulties with 2D
1515acceleration, while 3D graphics is accelerated well.
1516
1517=item No arbitrary limits
1518
1519Unlike other Crossfire clients, pclient does not suffer from arbitrary
1520limits (like a fixed amount of face numbers). There are still limits, but
1521they are not arbitrarily low :)
1522
1523=back
1524
1525=head1 USAGE
1526
1527=head2 The Map
1528
1529The map is always displayed in the background, behind all other windows and UI elements.
1530
1531#TODO# middle-click scrolls
1532#
1533# keys:
1534#
1535# a apply
1536# keypad moves, kp_5 applies ranged attack to self
1537
1538Starting to type enters the I<completion mode>. In that mode, you can type
1539abbreviations or commands and have them executed as soon as they match a
1540valid command. This is best explained by a few examples:
1541
1542Typing B<climb> will display a list of commands with I<climb> in their
1543name, such as I<ready_skill climbing> and I<use_skill climbing>.
1544
1545You can abbreviate commands by typing only the first character of every
1546word. For example, typing I<iwor> will likely select I<invoke word of
1547recall>, while I<ccfo> will select I<cast create food>. Likewise, I<rscli>
1548will likely select I<ready_skill climbing> and I<usl> will give you
1549I<use_skill levitation>.
1550
1551=head2 The map overview
1552
1553#TODO#
1554
1555=head2 The Status area in the lower right corner
1556
1557#TODO#
1558
1559=head2 The I<Statistics>/I>Stats> window
1560
1561#TODO#
1562
1563=head1 FAQ
1564
1565=over 4
1566
1567=item The client is very sluggish and slow, what can I do about this?
1568
1569Most likely, you don't have accelerated OpenGL support. Try to find a
1570newer driver, or a driver from your hardware vendor, that features OpenGL
1571support.
1572
1573If this is not an option, the following Setup options reduce the load and
1574will likely make the client playable with sofwtare rendering (it will
1575still be slow, though):
1576
1577=over 4
1578
1579=item B<Video Mode> should be set as low as possible (e.g. 640x480)
1580
1581=item Enable B<Fast & Ugly> mode
1582
1583=item Disable B<Fog of War>
1584
1585=item Increase B<Map Scale>
1586
1587=back
1588
1589=back
1590
1591=head1 AUTHOR
1592
1593Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
1594
1595
1596

Diff Legend

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