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.217 by elmex, Mon May 15 18:23:33 2006 UTC vs.
Revision 1.225 by root, Wed May 17 16:17:01 2006 UTC

1#!/opt/bin/perl 1#!/opt/bin/perl
2 2
3use strict; 3use strict;
4use utf8; 4use utf8;
5 5
6# do things only needed for single-binary version (par)
6BEGIN { 7BEGIN {
7 if (%PAR::LibCache) { 8 if (%PAR::LibCache) {
8 @INC = grep ref, @INC; # weed out all paths except pars loader refs 9 @INC = grep ref, @INC; # weed out all paths except pars loader refs
9 10
10 while (my ($filename, $zip) = each %PAR::LibCache) { 11 while (my ($filename, $zip) = each %PAR::LibCache) {
… …
13 $zip->extractMember ($_, "$ENV{PAR_TEMP}/$1") 14 $zip->extractMember ($_, "$ENV{PAR_TEMP}/$1")
14 unless -e "$ENV{PAR_TEMP}/$1"; 15 unless -e "$ENV{PAR_TEMP}/$1";
15 } 16 }
16 } 17 }
17 18
19 # TODO: pango-rc file, anybody?
20
18 unshift @INC, $ENV{PAR_TEMP}; 21 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 } 22 }
24} 23}
25 24
26# need to do it again because that pile of garbage called PAR nukes it before main 25# need to do it again because that pile of garbage called PAR nukes it before main
27unshift @INC, $ENV{PAR_TEMP}; 26unshift @INC, $ENV{PAR_TEMP}
27 if %PAR::LibCache;
28 28
29use Time::HiRes 'time'; 29use Time::HiRes 'time';
30use Pod::POM;
30use Event; 31use Event;
31 32
32use Crossfire; 33use Crossfire;
33use Crossfire::Protocol; 34use Crossfire::Protocol;
34 35
… …
100our $DEBUG_STATUS; 101our $DEBUG_STATUS;
101 102
102our $INVWIN; 103our $INVWIN;
103our $INV; 104our $INV;
104our $INVR; 105our $INVR;
106our $INVR_LBL;
105our $OPENCONT; 107our $OPENCONT;
106 108
107sub status { 109sub status {
108 $STATUSBOX->add ($_[0], pri => -10, group => "status", timeout => 20, fg => [1, 1, 0, 1]); 110 $STATUSBOX->add ($_[0], pri => -10, group => "status", timeout => 20, fg => [1, 1, 0, 1]);
109} 111}
… …
134 maph => $mapsize, 136 maph => $mapsize,
135 ; 137 ;
136 }; 138 };
137 139
138 if ($CONN) { 140 if ($CONN) {
141 CFClient::lowdelay fileno $CONN->{fh};
142
139 $LOGIN_BUTTON->set_text ("Logout"); 143 $LOGIN_BUTTON->set_text ("Logout");
140
141 status "login successful"; 144 status "login successful";
142 145
143 CFClient::lowdelay fileno $CONN->{fh}; 146 $BUTTONBAR->{children}[1]->emit ("activate")
147 if $BUTTONBAR->{children}[1]->{state};
148
144 } else { 149 } else {
145 status "unable to connect"; 150 status "unable to connect";
146 stop_game(); 151 stop_game();
147 } 152 }
148} 153}
… …
152 157
153 status "connection closed"; 158 status "connection closed";
154 $LOGIN_BUTTON->set_text ("Login"); 159 $LOGIN_BUTTON->set_text ("Login");
155 $CONN->destroy; 160 $CONN->destroy;
156 $CONN = 0; # false, does not autovivify 161 $CONN = 0; # false, does not autovivify
162
163 $BUTTONBAR->{children}[1]->emit ("activate")
164 unless $BUTTONBAR->{children}[1]->{state};
157 165
158 undef $MAPCACHE; 166 undef $MAPCACHE;
159 undef $MAP; 167 undef $MAP;
160} 168}
161 169
… …
665 $HOST->set_text ($CFG->{host} = $host); 673 $HOST->set_text ($CFG->{host} = $host);
666 }), 674 }),
667 (new CFClient::UI::Empty expand => 1), 675 (new CFClient::UI::Empty expand => 1),
668 ]); 676 ]);
669 677
670 $table->add ($_ + 1, $y, new CFClient::UI::Label align => $align[$_], text => $m->[$_], fontsize => 0.8) 678 $table->add ($_ + 1, $y, new CFClient::UI::Label
679 ellipsise => 0, align => $align[$_], text => $m->[$_], fontsize => 0.8)
671 for 0 .. $#$m; 680 for 0 .. $#$m;
672 } 681 }
673 } 682 }
674 }); 683 });
675} 684}
… …
813sub make_inventory_window { 822sub make_inventory_window {
814 my $invwin = new CFClient::UI::FancyFrame 823 my $invwin = new CFClient::UI::FancyFrame
815 user_w => $WIDTH * (4/5), user_h => $HEIGHT * (4/5), title => "Inventory"; 824 user_w => $WIDTH * (4/5), user_h => $HEIGHT * (4/5), title => "Inventory";
816 825
817 $invwin->add (my $hb = new CFClient::UI::HBox); 826 $invwin->add (my $hb = new CFClient::UI::HBox);
827
828 $hb->add (my $vb1 = new CFClient::UI::VBox expand => 1);
829 $vb1->add (my $lbl = new CFClient::UI::Label);
830 $lbl->set_text ("Player");
818 $hb->add ($INV = new CFClient::UI::Inventory expand => 1); 831 $vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
832
833 $hb->add (my $vb2 = new CFClient::UI::VBox expand => 1);
834 $vb2->add ($INVR_LBL = new CFClient::UI::Label);
835 $INVR_LBL->set_text ("Floor");
819 $hb->add ($INVR = new CFClient::UI::Inventory expand => 1); 836 $vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);
820 837
821 $invwin 838 $invwin
822} 839}
823 840
824sub sdl_init { 841sub sdl_init {
… …
1022 1039
1023@conn::ISA = Crossfire::Protocol::; 1040@conn::ISA = Crossfire::Protocol::;
1024 1041
1025sub conn::stats_update { 1042sub conn::stats_update {
1026 my ($self, $stats) = @_; 1043 my ($self, $stats) = @_;
1044
1045 if (my $exp = $stats->{Crossfire::Protocol::CS_STAT_EXP64}) {
1046 my $diff = $exp - $self->{prev_exp};
1047 $STATUSBOX->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5)
1048 if exists $self->{prev_exp} && $diff;
1049 $self->{prev_exp} = $exp;
1050 }
1027 1051
1028 update_stats_window ($stats); 1052 update_stats_window ($stats);
1029} 1053}
1030 1054
1031sub conn::user_send { 1055sub conn::user_send {
… …
1330 [0.74, 0.65, 0.41], 1354 [0.74, 0.65, 0.41],
1331 ); 1355 );
1332 1356
1333 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0]; 1357 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
1334 1358
1335 $text =~ s/&/&amp;/g; $text =~ s/</&lt;/g; 1359 $text = CFClient::UI::Label::escape $text;
1336 $text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g; 1360 $text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g;
1337 $text =~ s/\[color=(.*?)\](.*?)\[\/color\]/<span foreground='\1'>\2<\/span>/g; 1361 $text =~ s/\[color=(.*?)\](.*?)\[\/color\]/<span foreground='\1'>\2<\/span>/g;
1338 1362
1339 $LOGVIEW->add_paragraph ($color[$color], 1363 $LOGVIEW->add_paragraph ($color[$color],
1340 join "\n", map "$time $_", split /\n/, $text); 1364 join "\n", map "$time $_", split /\n/, $text);
… …
1356sub conn::spell_add { 1380sub conn::spell_add {
1357 my ($self, $spell) = @_; 1381 my ($self, $spell) = @_;
1358 1382
1359 # TODO 1383 # TODO
1360 # create a widget dynamically, using spell face (CF::Protocol downloads them) 1384 # create a widget dynamically, using spell face (CF::Protocol downloads them)
1361 $MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message}); 1385 $MAPWIDGET->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1362 $MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message}); 1386 $MAPWIDGET->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1363} 1387}
1364 1388
1365sub conn::spell_delete { 1389sub conn::spell_delete {
1366 my ($self, $spell) = @_; 1390 my ($self, $spell) = @_;
1367} 1391}
1368 1392
1369sub conn::addme_success { 1393sub conn::addme_success {
1370 my ($self) = @_; 1394 my ($self) = @_;
1371 1395
1396 $MAPWIDGET->clr_commands;
1397
1372 for my $skill (values %{$self->{skill_info}}) { 1398 for my $skill (values %{$self->{skill_info}}) {
1373 $MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'"); 1399 $MAPWIDGET->add_command ("ready_skill $skill", CFClient::UI::Label::escape "Ready the skill '$skill'");
1374 $MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'"); 1400 $MAPWIDGET->add_command ("use_skill $skill", CFClient::UI::Label::escape "Immediately use the skill '$skill'");
1375 } 1401 }
1376 1402
1377 $MAPWIDGET->add_command ("pet\\_mode defend", "Tell pets to stay close to you and defend you"); 1403 $MAPWIDGET->add_command ("petmode defend", "Tell pets to stay close to you and defend you");
1378 $MAPWIDGET->add_command ("pet\\_mode arena", "Same as petmode attack, but also attack other players"); 1404 $MAPWIDGET->add_command ("petmode arena", "Same as petmode sad, but also attack other players");
1379 $MAPWIDGET->add_command ("pet\\_mode sad", "Search &amp; Destroy - tell pets to roam about and attack enemies"); 1405 $MAPWIDGET->add_command ("petmode sad", "Search &amp; Destroy - tell pets to roam about and attack enemies");
1380 $MAPWIDGET->add_command ("kill\\_pets", "kill your pets"); 1406 $MAPWIDGET->add_command ("killpets", "Kill your pets");
1407 $MAPWIDGET->add_command ("chat", "chat TEXT\nChat with all other players");
1408 $MAPWIDGET->add_command ("shout", "shout TEXT\nShout loudly, used for emergencies");
1409 $MAPWIDGET->add_command ("tell", "tell USERNAME TEXT\nPrivately tell a specific player");
1410
1411 my $parser = new Pod::POM;
1412 my $pod = $parser->parse_file (CFClient::find_rcfile "pod/command_help.pod");
1413
1414 for my $head2 ($pod->head2) {
1415 $head2->title =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x
1416 or next;
1417
1418 my $cmd = $1;
1419 my @args = split /\|/, $2;
1420 @args = (".*") unless @args;
1421
1422 my $text = CFClient::pod_to_pango $head2->content;
1423
1424 for my $arg (@args) {
1425 $arg = $arg eq ".*" ? "" : " $arg";
1426
1427 $MAPWIDGET->add_command ("$cmd$arg", $text);
1428 }
1429 }
1381} 1430}
1382 1431
1383sub conn::eof { 1432sub conn::eof {
1433 $MAPWIDGET->clr_commands;
1434
1384 stop_game; 1435 stop_game;
1385} 1436}
1386 1437
1387sub update_floorbox { 1438sub update_floorbox {
1388 $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub { 1439 $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
… …
1406} 1457}
1407 1458
1408sub conn::container_add { 1459sub conn::container_add {
1409 my ($self, $tag, $items) = @_; 1460 my ($self, $tag, $items) = @_;
1410 1461
1411 print "container_add on conainer $tag (player: $self->{player}{tag})\n"; 1462 #d# print "container_add: container $tag ($self->{player}{tag})\n";
1412 1463
1413 if ($tag == 0) { 1464 if ($tag == 0) {
1414 update_floorbox; 1465 update_floorbox;
1466 $OPENCONT = 0;
1467 $INVR_LBL->set_text ("Floor");
1415 $INVR->set_items ($self->{container}{0}); 1468 $INVR->set_items ($self->{container}{0});
1416 $OPENCONT = 0;
1417 } elsif ($tag == $self->{player}{tag}) { 1469 } elsif ($tag == $self->{player}{tag}) {
1470 $INVR_LBL->set_text ("Player");
1418 $INV->set_items ($self->{container}{$self->{player}{tag}}) 1471 $INV->set_items ($self->{container}{$self->{player}{tag}})
1419 } else { 1472 } else {
1420 $OPENCONT = $tag; 1473 $OPENCONT = $tag;
1474 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1421 $INVR->set_items ($self->{container}{$tag}); 1475 $INVR->set_items ($self->{container}{$tag});
1422 } 1476 }
1423 1477
1424 # $self-<{player}{tag} => player inv 1478 # $self-<{player}{tag} => player inv
1425 #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}}; 1479 #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1426} 1480}
1427 1481
1428sub conn::container_clear { 1482sub conn::container_clear {
1429 my ($self, $tag) = @_; 1483 my ($self, $tag) = @_;
1430 1484
1431 print "container_clear on conainer $tag (player: $self->{player}{tag})\n"; 1485 #d# print "container_clear: container $tag ($self->{player}{tag})\n";
1432 1486
1433 if ($tag == 0) { 1487 if ($tag == 0) {
1434 update_floorbox; 1488 update_floorbox;
1489 $OPENCONT = 0;
1490 $INVR_LBL->set_text ("Floor");
1435 $INVR->set_items ($self->{container}{0}); 1491 $INVR->set_items ($self->{container}{0});
1436 $OPENCONT = 0;
1437 } elsif ($tag == $self->{player}{tag}) { 1492 } elsif ($tag == $self->{player}{tag}) {
1493 $INVR_LBL->set_text ("Player");
1438 $INV->set_items ($self->{container}{$tag}) 1494 $INV->set_items ($self->{container}{$tag})
1439 } else { 1495 } else {
1496 $OPENCONT = $tag;
1497 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1440 $INVR->set_items ($self->{container}{$tag}); 1498 $INVR->set_items ($self->{container}{$tag});
1441 $OPENCONT = $tag;
1442 } 1499 }
1443 1500
1444# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0}; 1501# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1445} 1502}
1446 1503
1447sub conn::item_delete { 1504sub conn::item_delete {
1448 my ($self, @items) = @_; 1505 my ($self, @items) = @_;
1449 1506
1450 for (@items) { 1507 for (@items) {
1451 print "item_delete on container $_->{container} (player: $self->{player}{tag})\n"; 1508 #d# print "item_delete: $_->{tag} from $_->{container} ($self->{player}{tag})\n";
1509
1452 if ($_->{container} == 0) { 1510 if ($_->{container} == 0) {
1453 update_floorbox; 1511 update_floorbox;
1512 $OPENCONT = 0;
1513 $INVR_LBL->set_text ("Floor");
1454 $INVR->set_items ($self->{container}{0}); 1514 $INVR->set_items ($self->{container}{0});
1455 } elsif ($_->{container} == $self->{player}{tag}) { 1515 } elsif ($_->{container} == $self->{player}{tag}) {
1516 $INVR_LBL->set_text ("Player");
1456 $INV->set_items ($self->{container}{$self->{player}{tag}}) 1517 $INV->set_items ($self->{container}{$self->{player}{tag}})
1457 } else { 1518 } else {
1519 $OPENCONT = $_->{container};
1520 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1458 $INVR->set_items ($self->{container}{0}); 1521 $INVR->set_items ($self->{container}{$_->{container}});
1459 } 1522 }
1460 } 1523 }
1461} 1524}
1462 1525
1463sub conn::item_update { 1526sub conn::item_update {
1464 my ($self, $item) = @_; 1527 my ($self, $item) = @_;
1465 1528
1466 print "item_update: container: $item->{container} (player: $self->{player}{tag})\n"; 1529 #d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($OPENCONT)\n";
1467 1530
1468 if ($item->{container} == 0) { 1531 if ($item->{tag} == $OPENCONT && not ($item->{flags} & Crossfire::Protocol::F_OPEN)) {
1469 update_floorbox; 1532 $OPENCONT = 0;
1533 $INVR_LBL->set_text ("Floor");
1470 $INVR->set_items ($self->{container}{0}); 1534 $INVR->set_items ($self->{container}{0});
1535
1536 $item->{widget}->update_item
1537 if $item->{widget};
1538 } else {
1539 if ($item->{container} == 0) {
1540 update_floorbox;
1541 $OPENCONT = 0;
1542 $INVR_LBL->set_text ("Floor");
1543 $INVR->set_items ($self->{container}{0});
1471 } elsif ($item->{container} == $self->{player}{tag}) { 1544 } elsif ($item->{container} == $self->{player}{tag}) {
1472 $INV->set_items ($self->{container}{$item->{container}}) 1545 $INV->set_items ($self->{container}{$item->{container}})
1546 }
1473 } 1547 }
1474} 1548}
1475 1549
1476%SDL_CB = ( 1550%SDL_CB = (
1477 CFClient::SDL_QUIT => sub { 1551 CFClient::SDL_QUIT => sub {
… …
1577 $FONT_FIXED = new_from_file CFClient::Font $fonts[1]; 1651 $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
1578 1652
1579 $FONT_PROP->make_default; 1653 $FONT_PROP->make_default;
1580 } 1654 }
1581 1655
1656# compare mono (ft) vs. rgba (cairo)
1657# ft - 1.8s, cairo 3s, even in alpha-only mode
1658# for my $rgba (0..1) {
1659# my $t1 = Time::HiRes::time;
1660# for (1..1000) {
1661# my $layout = CFClient::Layout->new ($rgba);
1662# $layout->set_text ("hallo" x 100);
1663# $layout->render;
1664# }
1665# my $t2 = Time::HiRes::time;
1666# warn $t2-$t1;
1667# }
1668
1582 video_init; 1669 video_init;
1583 audio_init; 1670 audio_init;
1584} 1671}
1585 1672
1586Event::loop; 1673Event::loop;

Diff Legend

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