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.171 by root, Mon Apr 24 03:33:51 2006 UTC vs.
Revision 1.212 by root, Fri May 12 15:45:42 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;
13 36
14use CFClient; 37use CFClient;
15use CFClient::UI; 38use CFClient::UI;
16use CFClient::MapWidget; 39use CFClient::MapWidget;
17 40
41$Event::DIED = sub {
42 # TODO: display dialog box or so
43 CFClient::error $_[1];
44};
45
46#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d#
47
18our $VERSION = '0.1'; 48our $VERSION = '0.1';
19 49
20my $MAX_FPS = 60; 50my $MAX_FPS = 60;
21my $MIN_FPS = 5; # unused as of yet 51my $MIN_FPS = 5; # unused as of yet
22 52
30our $NOW; 60our $NOW;
31 61
32our $CFG; 62our $CFG;
33our $CONN; 63our $CONN;
34our $FAST; # fast, low-quality mode, possibly useful for software-rendering 64our $FAST; # fast, low-quality mode, possibly useful for software-rendering
65
66our $WANT_REFRESH;
67our $CAN_REFRESH;
35 68
36our @SDL_MODES; 69our @SDL_MODES;
37our $WIDTH; 70our $WIDTH;
38our $HEIGHT; 71our $HEIGHT;
39our $FULLSCREEN; 72our $FULLSCREEN;
41 74
42our $FONT_PROP; 75our $FONT_PROP;
43our $FONT_FIXED; 76our $FONT_FIXED;
44 77
45our $MAP; 78our $MAP;
79our $MAPMAP;
46our $MAPWIDGET; 80our $MAPWIDGET;
47our $BUTTONBAR; 81our $BUTTONBAR;
48our $LOGVIEW; 82our $LOGVIEW;
49our $CONSOLE; 83our $CONSOLE;
50our $METASERVER; 84our $METASERVER;
85our $LOGIN_BUTTON;
51 86
87our $FLOORBOX;
52our $GAUGES; 88our $GAUGES;
53our $STATWIDS; 89our $STATWIDS;
54 90
55our $SDL_ACTIVE; 91our $SDL_ACTIVE;
56our %SDL_CB; 92our %SDL_CB;
58our $SDL_MIXER; 94our $SDL_MIXER;
59our @SOUNDS; # event => file mapping 95our @SOUNDS; # event => file mapping
60our %AUDIO_CHUNKS; # audio files 96our %AUDIO_CHUNKS; # audio files
61 97
62our $ALT_ENTER_MESSAGE; 98our $ALT_ENTER_MESSAGE;
63our $STATUS_LINE; 99our $STATUSBOX;
64our $DEBUG_STATUS; 100our $DEBUG_STATUS;
65 101
102our $INVWIN;
103our $INV;
104
66sub status { 105sub status {
67 $STATUS_LINE->set_text ($_[0]); 106 $STATUSBOX->add ($_[0], pri => -10, group => "status", timeout => 20, color => [1, 1, 0, 1]);
68 $STATUS_LINE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $STATUS_LINE->{h}); 107 $CFClient::UI::ROOT->on_post_alloc (status_line_positioner => sub {
108 my $widget = $STATUSBOX->{parent};
109 $widget->move (0, $HEIGHT - $widget->{h});#d# to in toplevel
110 });
69} 111}
70 112
71sub debug { 113sub debug {
72 $DEBUG_STATUS->set_text ($_[0]); 114 $DEBUG_STATUS->set_text ($_[0]);
73 $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);
74} 117}
75 118
76sub start_game { 119sub start_game {
77 status "logging in..."; 120 status "logging in...";
78 121
79 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;
80 123
81 $MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}"; 124 $MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";
82
83 $MAP = new CFClient::Map $mapsize, $mapsize; 125 $MAP = new CFClient::Map $mapsize, $mapsize;
84 126
85 my ($host, $port) = split /:/, $CFG->{host}; 127 my ($host, $port) = split /:/, $CFG->{host};
86 128
87 $CONN = new conn 129 $CONN = eval {
130 new conn
88 host => $host, 131 host => $host,
89 port => $port || 13327, 132 port => $port || 13327,
90 user => $CFG->{user}, 133 user => $CFG->{user},
91 pass => $CFG->{password}, 134 pass => $CFG->{password},
92 mapw => $mapsize, 135 mapw => $mapsize,
93 maph => $mapsize, 136 maph => $mapsize,
137 ;
94 ; 138 };
95 139
140 if ($CONN) {
141 $LOGIN_BUTTON->set_text ("Logout");
142
96 status "login successful"; 143 status "login successful";
97 144
98 CFClient::lowdelay fileno $CONN->{fh}; 145 CFClient::lowdelay fileno $CONN->{fh};
146 } else {
147 status "unable to connect";
148 stop_game();
149 }
99} 150}
100 151
101sub stop_game { 152sub 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;
102 undef $CONN; 161 undef $MAP;
103} 162}
104 163
105sub client_setup { 164sub client_setup {
106 my $dialog = new CFClient::UI::FancyFrame 165 my $dialog = new CFClient::UI::FancyFrame
107 title => "Client Setup", 166 title => "Client Setup",
283 audio_shutdown (); 342 audio_shutdown ();
284 audio_init (); 343 audio_init ();
285 } 344 }
286 ); 345 );
287 346
347 $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Communication cmd");
348 $table->add (1, $row++, my $saycmd = new CFClient::UI::Entry
349 text => $CFG->{say_command},
350 tooltip => "This is the command that will be used if you write a line in the message window entry. "
351 ."Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
352 ."But you could also set it to 'tell <playername>' to only chat with that user.",
353 connect_changed => sub {
354 my ($self, $value) = @_;
355 $CFG->{say_command} = $value;
356 }
357 );
358
288 $dialog 359 $dialog
289} 360}
290 361
291sub set_stats_window_fontsize { 362sub set_stats_window_fontsize {
292 for (values %{$STATWIDS}) { 363 for (values %{$STATWIDS}) {
308# my $gw = int ($WIDTH * $CFG->{gauge_w_size}); 379# my $gw = int ($WIDTH * $CFG->{gauge_w_size});
309 380
310 my $win = new CFClient::UI::Frame ( 381 my $win = new CFClient::UI::Frame (
311 y => $HEIGHT - $gh, x => 0, user_w => $WIDTH, user_h => $gh 382 y => $HEIGHT - $gh, x => 0, user_w => $WIDTH, user_h => $gh
312 ); 383 );
313 $win->add (my $vb = new CFClient::UI::VBox); 384 $win->add (my $hbox = new CFClient::UI::HBox
314 385 children => [
315 $vb->add (my $hbg = new CFClient::UI::HBox expand => 1); 386 (new CFClient::UI::HBox expand => 1),
387 (new CFClient::UI::VBox children => [
388 (new CFClient::UI::Empty expand => 1),
389 (new CFClient::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new CFClient::UI::VBox)),
390 ]),
391 (my $vbox = new CFClient::UI::VBox),
392 ],
393 );
316 394
395 $vbox->add (new CFClient::UI::HBox
396 expand => 1,
397 children => [
317 $hbg->add (new CFClient::UI::Empty expand => 1); 398 (new CFClient::UI::Empty expand => 1),
318 $hbg->add (my $hb = new CFClient::UI::HBox); 399 (my $hb = new CFClient::UI::HBox),
400 ],
401 );
402
319 $hb->add (my $hg = new CFClient::UI::Gauge type => 'hp', tooltip => "Health points"); 403 $hb->add (my $hg = new CFClient::UI::Gauge type => 'hp',
404 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.");
320 $hb->add (my $mg = new CFClient::UI::Gauge type => 'mana', tooltip => "Spellpoints"); 405 $hb->add (my $mg = new CFClient::UI::Gauge type => 'mana',
406 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.");
321 $hb->add (my $gg = new CFClient::UI::Gauge type => 'grace', tooltip => "Grace"); 407 $hb->add (my $gg = new CFClient::UI::Gauge type => 'grace',
408 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.");
322 $hb->add (my $fg = new CFClient::UI::Gauge type => 'food', tooltip => "Food"); 409 $hb->add (my $fg = new CFClient::UI::Gauge type => 'food',
410 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.");
323 411
324 $vb->add (my $exp = new CFClient::UI::Label valign => 0, align => 1, text => "XP: 0 LVL: 0"); 412 $vbox->add (my $exp = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
413 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.");
325 $vb->add (my $rng = new CFClient::UI::Label valign => 0, align => 1, text => "Rng:"); 414 $vbox->add (my $rng = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1,
415 tooltip => "Ranged attack - how you attack when you press shift-cursor (spell, skill, weapon etc.)");
326 416
327 $GAUGES = { 417 $GAUGES = {
328 exp => $exp, win => $win, range => $rng, 418 exp => $exp, win => $win, range => $rng,
329 food => $fg, mana => $mg, hp => $hg, grace => $gg 419 food => $fg, mana => $mg, hp => $hg, grace => $gg
330 }; 420 };
333 423
334 $win 424 $win
335} 425}
336 426
337sub make_stats_window { 427sub make_stats_window {
338 my $tgw = new CFClient::UI::FancyFrame (x => $WIDTH * 2/5, y => 0, title => "Stats"); 428 my $tgw = new CFClient::UI::FancyFrame x => $WIDTH * 2/5, y => 0, title => "Stats";
339 429
340 $tgw->add (my $vb = new CFClient::UI::VBox); 430 $tgw->add (new CFClient::UI::Window child => my $vb = new CFClient::UI::VBox);
341 $vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1); 431 $vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1);
342 $vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1); 432 $vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1);
343 433
344 $vb->add (my $hb = new CFClient::UI::HBox expand => 1); 434 $vb->add (my $hb = new CFClient::UI::HBox expand => 1);
345 435
346 $hb->add (my $tbl = new CFClient::UI::Table expand => 1); 436 $hb->add (my $tbl = new CFClient::UI::Table expand => 1);
347 437
348 $tbl->add (0, 0, $STATWIDS->{st_str} = new CFClient::UI::Label valign => 0, align => +1, template => "30"); 438 my $black = [0, 0, 0];
349 $tbl->add (0, 1, $STATWIDS->{st_dex} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
350 $tbl->add (0, 2, $STATWIDS->{st_con} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
351 $tbl->add (0, 3, $STATWIDS->{st_int} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
352 $tbl->add (0, 4, $STATWIDS->{st_wis} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
353 $tbl->add (0, 5, $STATWIDS->{st_pow} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
354 $tbl->add (0, 6, $STATWIDS->{st_cha} = new CFClient::UI::Label valign => 0, align => +1, template => "30");
355 439
356 $tbl->add (1, 0, $STATWIDS->{st_str_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Str"); 440 for (
357 $tbl->add (1, 1, $STATWIDS->{st_dex_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Dex"); 441 [0, 0, st_str => "Str", 30, "Physical Strength, determines damage dealt with weapons, how much you can carry, and how often you can attack"],
358 $tbl->add (1, 2, $STATWIDS->{st_con_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Con"); 442 [0, 1, st_dex => "Dex", 30, "Dexterity, your physical agility. Determines chance of being hit and affects armor class and speed"],
359 $tbl->add (1, 3, $STATWIDS->{st_int_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Int"); 443 [0, 2, st_con => "Con", 30, "Constitution, physical health and toughness. Determines how many healthpoints you can have"],
360 $tbl->add (1, 4, $STATWIDS->{st_wis_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Wis"); 444 [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"],
361 $tbl->add (1, 5, $STATWIDS->{st_pow_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Pow"); 445 [0, 4, st_wis => "Wis", 30, "Wisdom, the ability to learn and use divine magic (prayers). Determines how many grace points you can have"],
362 $tbl->add (1, 6, $STATWIDS->{st_cha_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Cha"); 446 [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"],
447 [0, 6, st_cha => "Cha", 30, "Charisma, how well you are received by NPCs. Affects buying and selling prices in shops."],
363 448
364 $tbl->add (2, 0, $STATWIDS->{st_wc} = new CFClient::UI::Label valign => 0, align => +1, template => "-120"); 449 [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."],
365 $tbl->add (2, 1, $STATWIDS->{st_ac} = new CFClient::UI::Label valign => 0, align => +1, template => "-120"); 450 [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."],
366 $tbl->add (2, 2, $STATWIDS->{st_dam} = new CFClient::UI::Label valign => 0, align => +1, template => "120"); 451 [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."],
367 $tbl->add (2, 3, $STATWIDS->{st_arm} = new CFClient::UI::Label valign => 0, align => +1, template => "120"); 452 [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."],
368 $tbl->add (2, 4, $STATWIDS->{st_spd} = new CFClient::UI::Label valign => 0, align => +1, template => "10.54"); 453 [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."],
369 $tbl->add (2, 5, $STATWIDS->{st_wspd} = new CFClient::UI::Label valign => 0, align => +1, template => "9"); 454 [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."],
455 ) {
456 my ($col, $row, $id, $label, $template, $tooltip) = @$_;
370 457
371 $tbl->add (3, 0, $STATWIDS->{st_wc_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Wc"); 458 $tbl->add ($col , $row, $STATWIDS->{$id} = new CFClient::UI::Label
372 $tbl->add (3, 1, $STATWIDS->{st_ac_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Ac"); 459 font => $FONT_FIXED, can_hover => 1, can_events => 1, valign => 0, align => +1, template => $template, tooltip => $tooltip);
373 $tbl->add (3, 2, $STATWIDS->{st_dam_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Dam"); 460 $tbl->add ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFClient::UI::Label
374 $tbl->add (3, 3, $STATWIDS->{st_arm_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Arm"); 461 font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $black, valign => 0, align => -1, text => $label, tooltip => $tooltip);
375 $tbl->add (3, 4, $STATWIDS->{st_spd_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "Sp"); 462 }
376 $tbl->add (3, 5, $STATWIDS->{st_wspd_lbl} = new CFClient::UI::Label valign => 0, align => -1, text => "WSp");
377 463
378 $hb->add (my $tbl2 = new CFClient::UI::Table expand => 1); 464 $hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);
379 465
380 my $row = 0; 466 my $row = 0;
381 my $col = 0; 467 my $col = 0;
382 468
383 my %resist_names = ( 469 my %resist_names = (
384 slow => "Slow", 470 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.)",
385 holyw => "Holy Word", 471 holyw => "Holy Word (resistance you against getting the fear when someone whose god doesn't like you spells the holy word on you.)",
386 conf => "Confusion", 472 conf => "Confusion (If you are hit by confusion you will move into random directions, and likely into monsters.)",
387 fire => "Fire", 473 fire => "Fire (just your resistance to fire spells like burning hands, dragonbreath, meteor swarm fire, ...)",
388 depl => "Depletion", 474 depl => "Depletion (some monsters and other effects can cause stats depletion)",
389 magic => "Magic", 475 magic => "Magic (resistance to magic spells like magic missile or similar)",
390 drain => "Draining", 476 drain => "Draining (some monsters (e.g. vampires) and other effects can steal experience)",
391 acid => "Acid", 477 acid => "Acid (resistance to acid, acid hurts pretty much and also corrodes your weapons)",
392 pois => "Poison", 478 pois => "Poison (resistance to getting poisoned)",
393 para => "Paralysation", 479 para => "Paralysation (this resistance affects the chance you get paralysed)",
394 deat => "Death", 480 deat => "Death (resistance against death spells)",
395 phys => "Physical", 481 phys => "Physical (this is the resistance against physical attacks, like when a monster hit you in melee combat)",
396 blind => "Blind", 482 blind => "Blind (blind resistance affects the chance of a successful blinding attack)",
397 fear => "Fear", 483 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)",
398 tund => "Turn undead", 484 tund => "Turn undead",
399 elec => "Electricity", 485 elec => "Electricity (resistance againt electricity, spells like large lightning, small lightning, ...)",
400 cold => "Cold", 486 cold => "Cold (this is your resistance against cold spells like icestorm, snowstorm, ...)",
401 ghit => "Ghost hit", 487 ghit => "Ghost hit (special attack used by ghosts and ghost-like beings)",
402 ); 488 );
403 for (qw/slow holyw conf fire depl magic 489 for (qw/slow holyw conf fire depl magic
404 drain acid pois para deat phys 490 drain acid pois para deat phys
405 blind fear tund elec cold ghit/) 491 blind fear tund elec cold ghit/)
406 { 492 {
407 $tbl2->add ($col, $row, 493 $tbl2->add ($col, $row,
408 $STATWIDS->{"res_$_"} = 494 $STATWIDS->{"res_$_"} =
409 new CFClient::UI::Label 495 new CFClient::UI::Label
496 font => $FONT_FIXED,
410 template => "-100%", 497 template => "-100%",
411 align => +1, 498 align => +1,
412 valign => 0, 499 valign => 0,
500 can_events => 1,
501 can_hover => 1,
413 tooltip => $resist_names{$_} 502 tooltip => $resist_names{$_},
414 ); 503 );
415 $tbl2->add ($col + 1, $row, new CFClient::UI::Image 504 $tbl2->add ($col + 1, $row, new CFClient::UI::Image
505 font => $FONT_FIXED,
416 can_hover => 1, 506 can_hover => 1,
417 can_events => 1, 507 can_events => 1,
418 image => "ui/resist/resist_$_.png", 508 image => "ui/resist/resist_$_.png",
419 tooltip => $resist_names{$_} 509 tooltip => $resist_names{$_},
420 ); 510 );
421 511
422 $row++; 512 $row++;
423 if ($row % 6 == 0) { 513 if ($row % 6 == 0) {
424 $col += 2; 514 $col += 2;
503 593
504} 594}
505 595
506sub metaserver_dialog { 596sub metaserver_dialog {
507 my $dialog = new CFClient::UI::FancyFrame 597 my $dialog = new CFClient::UI::FancyFrame
508 title => "Metaserver", 598 title => "Server List",
509 child => (my $vbox = new CFClient::UI::VBox); 599 child => (my $vbox = new CFClient::UI::VBox);
510 600
511 $vbox->add ($dialog->{table} = new CFClient::UI::Table); 601 $vbox->add ($dialog->{table} = new CFClient::UI::Table);
512 602
513 $dialog 603 $dialog
514} 604}
605
606my $METASERVER_ATIME;
515 607
516sub update_metaserver { 608sub update_metaserver {
517 my ($HOST) = @_; 609 my ($HOST) = @_;
518 610
519 status "fetching metaserver list..."; 611 return if $METASERVER_ATIME > time;
612 $METASERVER_ATIME = time + 60;
613
614 my $table = $METASERVER->{table};
615 $table->clear;
616 $table->add (0, 0, my $label = new CFClient::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
520 617
521 my $buf; 618 my $buf;
522 619
523 my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0; 620 my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;
621
622 unless ($fh) {
623 $label->set_text ("unable to contact metaserver: $!");
624 return;
625 }
524 626
525 Event->io (fd => $fh, poll => 'r', cb => sub { 627 Event->io (fd => $fh, poll => 'r', cb => sub {
526 my $res = sysread $fh, $buf, 8192, length $buf; 628 my $res = sysread $fh, $buf, 8192, length $buf;
527 629
528 if (!defined $res) { 630 if (!defined $res) {
529 $_[0]->w->cancel; 631 $_[0]->w->cancel;
530 status "metaserver: $!"; 632 $label->set_text ("error while retrieving server list: $!");
531 } elsif ($res == 0) { 633 } elsif ($res == 0) {
532 $_[0]->w->cancel; 634 $_[0]->w->cancel;
533 status "server list retrieved"; 635 status "server list retrieved";
534 636
535 my $table = $METASERVER->{table}; 637 utf8::decode $buf if utf8::valid $buf;
536 638
537 $table->clear; 639 $table->clear;
538 640
539 my @col = qw(Use #Users Host Uptime Version Description); 641 my @col = qw(Use #Users Host Uptime Version Description);
540 $table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_]) 642 $table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_])
564 $m = [$users, $host, $uptime, $version, $desc]; 666 $m = [$users, $host, $uptime, $version, $desc];
565 667
566 $y++; 668 $y++;
567 669
568 $table->add (0, $y, new CFClient::UI::VBox children => [ 670 $table->add (0, $y, new CFClient::UI::VBox children => [
569 (new CFClient::UI::Button text => " ", connect_activate => sub { 671 (new CFClient::UI::Button text => "Use", connect_activate => sub {
570 $HOST->set_text ($CFG->{host} = $host); 672 $HOST->set_text ($CFG->{host} = $host);
571 }), 673 }),
572 (new CFClient::UI::Empty expand => 1), 674 (new CFClient::UI::Empty expand => 1),
573 ]); 675 ]);
574 676
603 705
604 $METASERVER = metaserver_dialog; 706 $METASERVER = metaserver_dialog;
605 707
606 $vbox->add (new CFClient::UI::Flopper 708 $vbox->add (new CFClient::UI::Flopper
607 expand => 1, 709 expand => 1,
608 text => "Metaserver", 710 text => "Server List",
609 other => $METASERVER, 711 other => $METASERVER,
610 tooltip => "Show a list of avaible crossfire servers", 712 tooltip => "Show a list of available crossfire servers",
611 connect_open => sub { 713 connect_open => sub {
612 update_metaserver $HOST; 714 update_metaserver $HOST;
613 } 715 }
614 ); 716 );
615 } 717 }
630 hidden => 1, 732 hidden => 1,
631 tooltip => "The password for your character", 733 tooltip => "The password for your character",
632 connect_changed => sub { 734 connect_changed => sub {
633 my ($self, $value) = @_; 735 my ($self, $value) = @_;
634 $CFG->{password} = $value; 736 $CFG->{password} = $value;
635 }
636 );
637
638 $table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "Def. say cmd");
639 $table->add (1, 6, my $saycmd = new CFClient::UI::Entry
640 text => $CFG->{say_command},
641 tooltip => "This is the command that will be used if you write a line in the message window entry. "
642 ."Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
643 ."But you could also set it to 'tell <playername>' to only chat with that user.",
644 connect_changed => sub {
645 my ($self, $value) = @_;
646 $CFG->{say_command} = $value;
647 } 737 }
648 ); 738 );
649 739
650 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size"); 740 $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size");
651 $table->add (1, 7, new CFClient::UI::Slider 741 $table->add (1, 7, new CFClient::UI::Slider
658 748
659 $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 749 $CFG->{mapsize} = $self->{range}[0] = $value = int $value;
660 }, 750 },
661 ); 751 );
662 752
663 $table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Login", connect_activate => sub { 753 $table->add (1, 8, $LOGIN_BUTTON = new CFClient::UI::Button
754 expand => 1,
755 align => 0,
756 text => "Login",
757 connect_activate => sub {
758 $CONN ? stop_game
664 start_game; 759 : start_game;
760 },
665 }); 761 );
666 762
667 $dialog 763 $dialog
668} 764}
669 765
670sub message_window { 766sub message_window {
671 my $window = new CFClient::UI::FancyFrame 767 my $window = new CFClient::UI::FancyFrame
672 title => "Messages", 768 title => "Messages",
673 border_bg => [1, 1, 1, 0.5], 769 border_bg => [1, 1, 1, 1],
674 bg => [0.3, 0.3, 0.3, 0.8], 770 bg => [0, 0, 0, 0.5],
675 user_w => int $::WIDTH / 3, 771 user_w => int $::WIDTH / 3,
676 user_h => int $::HEIGHT / 5, 772 user_h => int $::HEIGHT / 5,
677 child => (my $vbox = new CFClient::UI::VBox); 773 child => (my $vbox = new CFClient::UI::VBox);
678 774
679 $vbox->add ($LOGVIEW = new CFClient::UI::TextView 775 $vbox->add ($LOGVIEW = new CFClient::UI::TextView
719 }; 815 };
720 816
721 $window 817 $window
722} 818}
723 819
820sub make_inventory_window {
821 my $invwin = new CFClient::UI::FancyFrame user_w => 300, user_h => 300, title => "Inventory";
822 $invwin->add ($INV = new CFClient::UI::Inventory expand => 1);
823 $invwin
824}
825
724sub sdl_init { 826sub sdl_init {
725 CFClient::SDL_Init 827 CFClient::SDL_Init
726 and die "SDL::Init failed!\n"; 828 and die "SDL::Init failed!\n";
727} 829}
728 830
729sub video_init { 831sub video_init {
730 sdl_init; 832 sdl_init;
731 833
834 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
835
732 ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] }; 836 ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
733 $FULLSCREEN = $CFG->{fullscreen}; 837 $FULLSCREEN = $CFG->{fullscreen};
734 $FAST = $CFG->{fast}; 838 $FAST = $CFG->{fast};
735 839
736 CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN 840 CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN
737 or die "SDL_SetVideoMode failed!\n"; 841 or die "SDL_SetVideoMode failed!\n";
738 842
739 $SDL_ACTIVE = 1; 843 $SDL_ACTIVE = 1;
740
741 $LAST_REFRESH = time - 0.01; 844 $LAST_REFRESH = time - 0.01;
742 845
743 CFClient::gl_init; 846 CFClient::gl_init;
744 847
745 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize}; 848 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
746 849
850 $CFClient::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
851
747 ############################################################################# 852 #############################################################################
748 853
854 if ($DEBUG_STATUS) {
855 # reconfigure all widgets
856 $CFClient::UI::ROOT->reconfigure;
857
858 } else {
859 # create the widgets
860
749 $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100; 861 $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100, text => "hulla", x => 100;#d#
750 $DEBUG_STATUS->show; 862 $DEBUG_STATUS->show;
751 863
752 $STATUS_LINE = new CFClient::UI::Label 864 $STATUSBOX = new CFClient::UI::Statusbox;
753 padding => 0, 865 $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", pri => -100, size => 0.8, color => [1, 1, 1, 0.8]);
754 y => $HEIGHT - $FONTSIZE * 1.8;
755 $STATUS_LINE->show;
756 866
757 $ALT_ENTER_MESSAGE = new CFClient::UI::Label 867 (new CFClient::UI::Frame
758 padding => 0, 868 bg => [0, 0, 0, 0.4],
759 fontsize => 0.8, 869 child => $STATUSBOX,
760 markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode"; 870 )->show;
761 $ALT_ENTER_MESSAGE->show;
762 $ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h});
763 871
764 $CFClient::UI::ROOT->add ($MAPWIDGET = new CFClient::MapWidget); 872 CFClient::UI::FancyFrame->new (
765 $MAPWIDGET->focus_in; 873 border_bg => [1, 1, 1, 192/255],
874 bg => [1, 1, 1, 0],
875 child => ($MAPMAP = new CFClient::MapWidget::MapMap),
876 )->show;
877
878 $MAPWIDGET = new CFClient::MapWidget;
766 $MAPWIDGET->connect (activate_console => sub { 879 $MAPWIDGET->connect (activate_console => sub {
767 my ($mapwidget, $preset) = @_; 880 my ($mapwidget, $preset) = @_;
768 881
769 if ($CONSOLE) { 882 if ($CONSOLE) {
770 $CONSOLE->{input}->{auto_activated} = 1; 883 $CONSOLE->{input}->{auto_activated} = 1;
771 $CONSOLE->{input}->focus_in; 884 $CONSOLE->{input}->focus_in;
772 885
773 if ($preset && $CONSOLE->{input}->get_text eq '') { 886 if ($preset && $CONSOLE->{input}->get_text eq '') {
774 $CONSOLE->{input}->set_text ($preset); 887 $CONSOLE->{input}->set_text ($preset);
888 }
775 } 889 }
776 } 890 });
777 }); 891 $MAPWIDGET->show;
892 $MAPWIDGET->focus_in;
778 893
779 $CFClient::UI::ROOT->add ($BUTTONBAR = new CFClient::UI::HBox); 894 $BUTTONBAR = new CFClient::UI::HBox;
780 895
781 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup); 896 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup);
782 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup); 897 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup);
783 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window); 898 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window);
784 899
785 $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 900 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
901
786 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window); 902 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window);
903 $BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => make_inventory_window);
787 904
788 $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub { 905 $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub {
789 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc"; 906 CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
790 status "Configuration Saved"; 907 status "Configuration Saved";
791 }); 908 });
792 909
910 $BUTTONBAR->show;
911
912 # delay till geometry is constant
913 $CFClient::UI::ROOT->on_post_alloc (startup => sub {
793 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup 914 $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
915 });
916 force_refresh ();
917 }
794} 918}
795 919
796sub video_shutdown { 920sub video_shutdown {
797 $CFClient::UI::ROOT->{children} = [];
798 undef $SDL_ACTIVE; 921 undef $SDL_ACTIVE;
799} 922}
800 923
801my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d# 924my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d#
802my $bgmusic;#TODO#hack#d# 925my $bgmusic;#TODO#hack#d#
926
927sub audio_channel_finished {
928 my ($channel) = @_;
929
930 warn "channel $channel finished\n";#d#
931}
803 932
804sub audio_music_finished { 933sub audio_music_finished {
805 return unless $CFG->{bgm_enable}; 934 return unless $CFG->{bgm_enable};
806 935
807 # TODO: hack, do play loop and mood music 936 # TODO: hack, do play loop and mood music
811 push @bgmusic, shift @bgmusic; 940 push @bgmusic, shift @bgmusic;
812} 941}
813 942
814sub audio_init { 943sub audio_init {
815 if ($CFG->{audio_enable}) { 944 if ($CFG->{audio_enable}) {
816 if (open my $fh, "<:utf8", CFClient::find_rcfile "sounds/config") { 945 if (open my $fh, "<", CFClient::find_rcfile "sounds/config") {
817 $SDL_MIXER = !CFClient::Mix_OpenAudio; 946 $SDL_MIXER = !CFClient::Mix_OpenAudio;
818 CFClient::Mix_AllocateChannels 8; 947 CFClient::Mix_AllocateChannels 8;
819 CFClient::MixMusic::volume $CFG->{bgm_volume} * 128; 948 CFClient::MixMusic::volume $CFG->{bgm_volume} * 128;
820 949
821 audio_music_finished; 950 audio_music_finished;
848} 977}
849 978
850my %animate_object; 979my %animate_object;
851my $animate_timer; 980my $animate_timer;
852 981
853my $want_refresh;
854my $can_refresh;
855
856my $fps = 9; 982my $fps = 9;
857 983
858sub force_refresh { 984sub force_refresh {
859 $fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05; 985 $fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05;
860 debug sprintf "%3.2f", $fps; 986 debug sprintf "%3.2f", $fps;
861 987
862 $want_refresh = 0;
863 $can_refresh = 0;
864
865 $CFClient::UI::ROOT->draw; 988 $CFClient::UI::ROOT->draw;
866
867 CFClient::SDL_GL_SwapBuffers; 989 CFClient::SDL_GL_SwapBuffers;
868 990
991 $WANT_REFRESH = 0;
992 $CAN_REFRESH = 0;
869 $LAST_REFRESH = $NOW; 993 $LAST_REFRESH = $NOW;
870} 994}
871 995
872my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub { 996my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {
873 $NOW = time; 997 $NOW = time;
875 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_) 999 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
876 for CFClient::SDL_PollEvent; 1000 for CFClient::SDL_PollEvent;
877 1001
878 if (%animate_object) { 1002 if (%animate_object) {
879 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object; 1003 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
880 $want_refresh++; 1004 $WANT_REFRESH++;
881 } 1005 }
882 1006
883 if ($want_refresh) { 1007 if ($WANT_REFRESH) {
884 force_refresh; 1008 force_refresh;
885 } else { 1009 } else {
886 $can_refresh = 1; 1010 $CAN_REFRESH = 1;
887 } 1011 }
888}); 1012});
889
890sub refresh {
891 $want_refresh++;
892}
893 1013
894sub animation_start { 1014sub animation_start {
895 my ($widget) = @_; 1015 my ($widget) = @_;
896 $animate_object{$widget} = $widget; 1016 $animate_object{$widget} = $widget;
897} 1017}
976# at worst. 1096# at worst.
977sub conn::flood_fill { 1097sub conn::flood_fill {
978 my ($self, $gx, $gy, $path, $hash, $flags) = @_; 1098 my ($self, $gx, $gy, $path, $hash, $flags) = @_;
979 1099
980 # the server does not allow map paths > 6 1100 # the server does not allow map paths > 6
981 return if 6 <= length $path; 1101 return if 7 <= length $path;
982 1102
983 my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}}; 1103 my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
984 1104
985 for ( 1105 for (
986 [1, 0, -1], 1106 [1, 0, -1],
1029 1149
1030 $self->flush_map; 1150 $self->flush_map;
1031 1151
1032 my ($ox, $oy) = ($::MAP->ox, $::MAP->oy); 1152 my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
1033 1153
1034 my $mapmapw = 250; 1154 my $mapmapw = $MAPMAP->{w};
1035 my $mapmaph = 250; 1155 my $mapmaph = $MAPMAP->{h};
1036 1156
1037 $self->{neigh_rect} = [ 1157 $self->{neigh_rect} = [
1038 $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5, 1158 $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5,
1039 $ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h, 1159 $ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h,
1040 ]; 1160 ];
1083 } 1203 }
1084 1204
1085gotid: 1205gotid:
1086 $face->{id} = $id; 1206 $face->{id} = $id;
1087 $MAP->set_face ($facenum => $id); 1207 $MAP->set_face ($facenum => $id);
1208 $self->{faceid}[$facenum] = $id;#d#
1088 $TILECACHE->get ($id) 1209 $TILECACHE->get ($id)
1089} 1210}
1090 1211
1091sub conn::face_update { 1212sub conn::face_update {
1092 my ($self, $facenum, $face) = @_; 1213 my ($self, $facenum, $face) = @_;
1100 my ($self, $id, $data) = @_; 1221 my ($self, $id, $data) = @_;
1101 1222
1102 $self->{texture}[$id] ||= do { 1223 $self->{texture}[$id] ||= do {
1103 my $tex = 1224 my $tex =
1104 new_from_image CFClient::Texture 1225 new_from_image CFClient::Texture
1105 $data, minify => 1; 1226 $data, minify => 1, mipmap => 1;
1106 1227
1107 $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}}); 1228 $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
1108 $MAPWIDGET->update; 1229 $MAPWIDGET->update;
1109 1230
1110 $tex 1231 $tex
1208 [0.55, 0.41, 0.13], 1329 [0.55, 0.41, 0.13],
1209 [0.99, 0.77, 0.26], 1330 [0.99, 0.77, 0.26],
1210 [0.74, 0.65, 0.41], 1331 [0.74, 0.65, 0.41],
1211 ); 1332 );
1212 1333
1334 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
1335
1336 $text =~ s/&/&amp;/g; $text =~ s/</&lt;/g;
1337 $text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g;
1338 $text =~ s/\[color=(.*?)\](.*?)\[\/color\]/<span foreground='\1'>\2<\/span>/g;
1339
1213 $LOGVIEW->add_paragraph ($color[$color], $text); 1340 $LOGVIEW->add_paragraph ($color[$color],
1341 join "\n", map "$time $_", split /\n/, $text);
1342
1343 $STATUSBOX->add ($text,
1344 group => $text,
1345 color => $color[$color],
1346 timeout => 60,
1347 tooltip_font => $::FONT_FIXED,
1348 );
1349}
1350
1351sub conn::drawextinfo {
1352 my ($self, $color, $type, $subtype, $message) = @_;
1353
1354 $self->drawinfo ($color, $message);
1214} 1355}
1215 1356
1216sub conn::spell_add { 1357sub conn::spell_add {
1217 my ($self, $spell) = @_; 1358 my ($self, $spell) = @_;
1218 1359
1231 1372
1232 for my $skill (values %{$self->{skill_info}}) { 1373 for my $skill (values %{$self->{skill_info}}) {
1233 $MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'"); 1374 $MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'");
1234 $MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'"); 1375 $MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'");
1235 } 1376 }
1377
1378 $MAPWIDGET->add_command ("pet\\_mode defend", "Tell pets to stay close to you and defend you");
1379 $MAPWIDGET->add_command ("pet\\_mode arena", "Same as petmode attack, but also attack other players");
1380 $MAPWIDGET->add_command ("pet\\_mode sad", "Search &amp; Destroy - tell pets to roam about and attack enemies");
1381 $MAPWIDGET->add_command ("kill\\_pets", "kill your pets");
1382}
1383
1384sub conn::eof {
1385 stop_game;
1386}
1387
1388sub update_floorbox {
1389 $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
1390 return unless $CONN;
1391
1392 $FLOORBOX->clear;
1393 $FLOORBOX->add (new CFClient::UI::Empty expand => 1);
1394
1395 my $count = 4;
1396 for (@{ $CONN->{container}{0} }) {
1397 if (--$count) {
1398 $FLOORBOX->add (new CFClient::UI::InventoryItem item => $_);
1399 } else {
1400 $FLOORBOX->add (new CFClient::UI::Label text => "More...");
1401 last;
1402 }
1403 }
1404 });
1405
1406 $WANT_REFRESH++;
1236} 1407}
1237 1408
1238sub conn::container_add { 1409sub conn::container_add {
1239 my ($self, $id, $items) = @_; 1410 my ($self, $tag, $items) = @_;
1240 1411
1241 # 0 floor 1412 update_floorbox if $tag == 0;
1413
1414 $INV->set_items ($self->{container}{$self->{player}{tag}})
1415 if $tag == $self->{player}{tag};
1416
1242 # $self-<{player}{tag} => player inv 1417 # $self-<{player}{tag} => player inv
1243 #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}}; 1418 #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1244} 1419}
1245 1420
1246sub conn::container_clear { 1421sub conn::container_clear {
1247 my ($self, $id) = @_; 1422 my ($self, $tag) = @_;
1423
1424 update_floorbox if $tag == 0;
1425
1426 $INV->set_items ($self->{container}{$tag})
1427 if $tag == $self->{player}{tag};
1428
1248# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0}; 1429# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1430}
1431
1432sub conn::item_delete {
1433 my ($self, @items) = @_;
1434
1435 for (@items) {
1436 update_floorbox if $_->{container} == 0;
1437
1438 $INV->set_items ($self->{container}{$_->{container}})
1439 if $_->{container} == $self->{player}{tag};
1440 }
1441}
1442
1443sub conn::item_update {
1444 my ($self, $item) = @_;
1445
1446 update_floorbox if $item->{container} == 0;
1447
1448 $INV->set_items ($self->{container}{$item->{container}})
1449 if $item->{container} == $self->{player}{tag};
1249} 1450}
1250 1451
1251%SDL_CB = ( 1452%SDL_CB = (
1252 CFClient::SDL_QUIT => sub { 1453 CFClient::SDL_QUIT => sub {
1253 Event::unloop -1; 1454 Event::unloop -1;
1254 }, 1455 },
1255 CFClient::SDL_VIDEORESIZE => sub { 1456 CFClient::SDL_VIDEORESIZE => sub {
1256 }, 1457 },
1257 CFClient::SDL_VIDEOEXPOSE => \&refresh, 1458 CFClient::SDL_VIDEOEXPOSE => sub {
1459 $WANT_REFRESH++;
1460 },
1258 CFClient::SDL_ACTIVEEVENT => sub { 1461 CFClient::SDL_ACTIVEEVENT => sub {
1259# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d# 1462# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d#
1260 }, 1463 },
1261 CFClient::SDL_KEYDOWN => sub { 1464 CFClient::SDL_KEYDOWN => sub {
1262 if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) { 1465 if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) {
1266 video_init; 1469 video_init;
1267 } else { 1470 } else {
1268 CFClient::UI::feed_sdl_key_down_event ($_[0]); 1471 CFClient::UI::feed_sdl_key_down_event ($_[0]);
1269 } 1472 }
1270 }, 1473 },
1271 CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event, 1474 CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event,
1272 CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event, 1475 CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event,
1273 CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event, 1476 CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event,
1274 CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event, 1477 CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event,
1275 CFClient::SDL_USEREVENT => \&audio_music_finished, 1478 CFClient::SDL_USEREVENT => sub {
1479 if ($_[0]{code} == 1) {
1480 audio_channel_finished $_[0]{data1};
1481 } elsif ($_[0]{code} == 0) {
1482 audio_music_finished;
1483 }
1484 },
1276); 1485);
1277 1486
1278############################################################################# 1487#############################################################################
1279 1488
1280$SIG{INT} = $SIG{TERM} = sub { exit }; 1489$SIG{INT} = $SIG{TERM} = sub { exit };
1281 1490
1282$TILECACHE = CFClient::db_table "tilecache";
1283$FACEMAP = CFClient::db_table "facemap";
1284
1285CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
1286
1287my %DEF_CFG = (
1288 sdl_mode => 0,
1289 width => 640,
1290 height => 480,
1291 fullscreen => 0,
1292 fast => 0,
1293 map_scale => 0.5,
1294 fow_enable => 1,
1295 fow_intensity => 0.45,
1296 fow_smooth => 0,
1297 gui_fontsize => 1,
1298 log_fontsize => 1,
1299 gauge_fontsize => 1,
1300 gauge_size => 0.35,
1301 stat_fontsize => 1,
1302 mapsize => 100,
1303 host => "crossfire.schmorp.de",
1304 say_command => 'say',
1305 audio_enable => 1,
1306 bgm_enable => 1,
1307 bgm_volume => 0.25,
1308);
1309
1310while (my ($k, $v) = each %DEF_CFG) {
1311 $CFG->{$k} = $v unless exists $CFG->{$k};
1312}
1313
1314sdl_init;
1315
1316@SDL_MODES = reverse
1317 grep $_->[0] >= 640 && $_->[1] >= 480,
1318 CFClient::SDL_ListModes;
1319
1320@SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
1321
1322$CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
1323
1324{ 1491{
1492 local $SIG{__DIE__} = sub { CFClient::fatal $_[0] };
1493
1494 CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
1495
1496 $TILECACHE = CFClient::db_table "tilecache";
1497 $FACEMAP = CFClient::db_table "facemap";
1498
1499 my %DEF_CFG = (
1500 sdl_mode => 0,
1501 width => 640,
1502 height => 480,
1503 fullscreen => 0,
1504 fast => 0,
1505 map_scale => 0.5,
1506 fow_enable => 1,
1507 fow_intensity => 0.45,
1508 fow_smooth => 0,
1509 gui_fontsize => 1,
1510 log_fontsize => 1,
1511 gauge_fontsize=> 1,
1512 gauge_size => 0.35,
1513 stat_fontsize => 1,
1514 mapsize => 100,
1515 host => "crossfire.schmorp.de",
1516 say_command => 'say',
1517 audio_enable => 1,
1518 bgm_enable => 1,
1519 bgm_volume => 0.25,
1520 );
1521
1522 while (my ($k, $v) = each %DEF_CFG) {
1523 $CFG->{$k} = $v unless exists $CFG->{$k};
1524 }
1525
1526 sdl_init;
1527
1528 @SDL_MODES = reverse
1529 grep $_->[0] >= 640 && $_->[1] >= 480,
1530 CFClient::SDL_ListModes;
1531
1532 @SDL_MODES or CFClient::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
1533
1534 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
1535
1536 {
1325 my @fonts = map CFClient::find_rcfile "fonts/$_", qw( 1537 my @fonts = map CFClient::find_rcfile "fonts/$_", qw(
1326 DejaVuSans.ttf 1538 DejaVuSans.ttf
1327 DejaVuSansMono.ttf 1539 DejaVuSansMono.ttf
1328 DejaVuSans-Bold.ttf 1540 DejaVuSans-Bold.ttf
1329 DejaVuSansMono-Bold.ttf 1541 DejaVuSansMono-Bold.ttf
1330 DejaVuSans-Oblique.ttf 1542 DejaVuSans-Oblique.ttf
1331 DejaVuSansMono-Oblique.ttf 1543 DejaVuSansMono-Oblique.ttf
1332 DejaVuSans-BoldOblique.ttf 1544 DejaVuSans-BoldOblique.ttf
1333 DejaVuSansMono-BoldOblique.ttf 1545 DejaVuSansMono-BoldOblique.ttf
1334 ); 1546 );
1335 1547
1336 CFClient::add_font $_ for @fonts; 1548 CFClient::add_font $_ for @fonts;
1337 1549
1338 $FONT_PROP = new_from_file CFClient::Font $fonts[0]; 1550 $FONT_PROP = new_from_file CFClient::Font $fonts[0];
1339 $FONT_FIXED = new_from_file CFClient::Font $fonts[1]; 1551 $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
1340 1552
1341 $FONT_PROP->make_default; 1553 $FONT_PROP->make_default;
1342} 1554 }
1343 1555
1344video_init; 1556 video_init;
1345audio_init; 1557 audio_init;
1558}
1346 1559
1347Event::loop; 1560Event::loop;
1348 1561
1349END { CFClient::SDL_Quit } 1562END { CFClient::SDL_Quit }
1350 1563
1564=head1 pclient - Crossfire+ and Crossfire game client
1351 1565
1566Pclient is a Crossfire+ and Crossfire game client.
1567
1568=head2 Features
1569
1570=over 4
1571
1572=item Fullscreen Map
1573
1574PClient can uses a fullscreen map, which greatly enhances how much of the
1575game world you can see.
1576
1577=item Persistent Map Cache (Crossfire+ only)
1578
1579PClient can persistently cache all map data it received from the
1580server. This not only allows it to display an overview map, but also
1581ensures that once-explored areas will be available the next time you want
1582to explore more.
1583
1584=item Hardware acceleration
1585
1586Unlike most Crossfire clients, PClient take advantage of OpenGL hardware
1587acceleration. Most modern graphics cards have difficulties with 2D
1588acceleration, while 3D graphics is accelerated well.
1589
1590=item No arbitrary limits
1591
1592Unlike other Crossfire clients, pclient does not suffer from arbitrary
1593limits (like a fixed amount of face numbers). There are still limits, but
1594they are not arbitrarily low :)
1595
1596=back
1597
1598=head1 USAGE
1599
1600=head2 The Map
1601
1602The map is always displayed in the background, behind all other windows and UI elements.
1603
1604#TODO# middle-click scrolls
1605#
1606# keys:
1607#
1608# a apply
1609# keypad moves, kp_5 applies ranged attack to self
1610
1611Starting to type enters the I<completion mode>. In that mode, you can type
1612abbreviations or commands and have them executed as soon as they match a
1613valid command. This is best explained by a few examples:
1614
1615Typing B<climb> will display a list of commands with I<climb> in their
1616name, such as I<ready_skill climbing> and I<use_skill climbing>.
1617
1618You can abbreviate commands by typing only the first character of every
1619word. For example, typing I<iwor> will likely select I<invoke word of
1620recall>, while I<ccfo> will select I<cast create food>. Likewise, I<rscli>
1621will likely select I<ready_skill climbing> and I<usl> will give you
1622I<use_skill levitation>.
1623
1624=head2 The map overview
1625
1626#TODO#
1627
1628=head2 The Status area in the lower right corner
1629
1630#TODO#
1631
1632=head2 The I<Statistics>/I>Stats> window
1633
1634#TODO#
1635
1636=head1 FAQ
1637
1638=over 4
1639
1640=item The client is very sluggish and slow, what can I do about this?
1641
1642Most likely, you don't have accelerated OpenGL support. Try to find a
1643newer driver, or a driver from your hardware vendor, that features OpenGL
1644support.
1645
1646If this is not an option, the following Setup options reduce the load and
1647will likely make the client playable with sofwtare rendering (it will
1648still be slow, though):
1649
1650=over 4
1651
1652=item B<Video Mode> should be set as low as possible (e.g. 640x480)
1653
1654=item Enable B<Fast & Ugly> mode
1655
1656=item Disable B<Fog of War>
1657
1658=item Increase B<Map Scale>
1659
1660=back
1661
1662=back
1663
1664=head1 AUTHOR
1665
1666Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
1667
1668
1669

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines