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.224 by root, Wed May 17 15:18:57 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}
… …
665 $HOST->set_text ($CFG->{host} = $host); 667 $HOST->set_text ($CFG->{host} = $host);
666 }), 668 }),
667 (new CFClient::UI::Empty expand => 1), 669 (new CFClient::UI::Empty expand => 1),
668 ]); 670 ]);
669 671
670 $table->add ($_ + 1, $y, new CFClient::UI::Label align => $align[$_], text => $m->[$_], fontsize => 0.8) 672 $table->add ($_ + 1, $y, new CFClient::UI::Label
673 ellipsise => 0, align => $align[$_], text => $m->[$_], fontsize => 0.8)
671 for 0 .. $#$m; 674 for 0 .. $#$m;
672 } 675 }
673 } 676 }
674 }); 677 });
675} 678}
… …
813sub make_inventory_window { 816sub make_inventory_window {
814 my $invwin = new CFClient::UI::FancyFrame 817 my $invwin = new CFClient::UI::FancyFrame
815 user_w => $WIDTH * (4/5), user_h => $HEIGHT * (4/5), title => "Inventory"; 818 user_w => $WIDTH * (4/5), user_h => $HEIGHT * (4/5), title => "Inventory";
816 819
817 $invwin->add (my $hb = new CFClient::UI::HBox); 820 $invwin->add (my $hb = new CFClient::UI::HBox);
821
822 $hb->add (my $vb1 = new CFClient::UI::VBox expand => 1);
823 $vb1->add (my $lbl = new CFClient::UI::Label);
824 $lbl->set_text ("Player");
818 $hb->add ($INV = new CFClient::UI::Inventory expand => 1); 825 $vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
826
827 $hb->add (my $vb2 = new CFClient::UI::VBox expand => 1);
828 $vb2->add ($INVR_LBL = new CFClient::UI::Label);
829 $INVR_LBL->set_text ("Floor");
819 $hb->add ($INVR = new CFClient::UI::Inventory expand => 1); 830 $vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);
820 831
821 $invwin 832 $invwin
822} 833}
823 834
824sub sdl_init { 835sub sdl_init {
… …
1022 1033
1023@conn::ISA = Crossfire::Protocol::; 1034@conn::ISA = Crossfire::Protocol::;
1024 1035
1025sub conn::stats_update { 1036sub conn::stats_update {
1026 my ($self, $stats) = @_; 1037 my ($self, $stats) = @_;
1038
1039 if (my $exp = $stats->{Crossfire::Protocol::CS_STAT_EXP64}) {
1040 my $diff = $exp - $self->{prev_exp};
1041 $STATUSBOX->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5)
1042 if exists $self->{prev_exp} && $diff;
1043 $self->{prev_exp} = $exp;
1044 }
1027 1045
1028 update_stats_window ($stats); 1046 update_stats_window ($stats);
1029} 1047}
1030 1048
1031sub conn::user_send { 1049sub conn::user_send {
… …
1330 [0.74, 0.65, 0.41], 1348 [0.74, 0.65, 0.41],
1331 ); 1349 );
1332 1350
1333 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0]; 1351 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
1334 1352
1335 $text =~ s/&/&amp;/g; $text =~ s/</&lt;/g; 1353 $text = CFClient::UI::Label::escape $text;
1336 $text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g; 1354 $text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g;
1337 $text =~ s/\[color=(.*?)\](.*?)\[\/color\]/<span foreground='\1'>\2<\/span>/g; 1355 $text =~ s/\[color=(.*?)\](.*?)\[\/color\]/<span foreground='\1'>\2<\/span>/g;
1338 1356
1339 $LOGVIEW->add_paragraph ($color[$color], 1357 $LOGVIEW->add_paragraph ($color[$color],
1340 join "\n", map "$time $_", split /\n/, $text); 1358 join "\n", map "$time $_", split /\n/, $text);
… …
1356sub conn::spell_add { 1374sub conn::spell_add {
1357 my ($self, $spell) = @_; 1375 my ($self, $spell) = @_;
1358 1376
1359 # TODO 1377 # TODO
1360 # create a widget dynamically, using spell face (CF::Protocol downloads them) 1378 # create a widget dynamically, using spell face (CF::Protocol downloads them)
1361 $MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message}); 1379 $MAPWIDGET->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1362 $MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message}); 1380 $MAPWIDGET->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1363} 1381}
1364 1382
1365sub conn::spell_delete { 1383sub conn::spell_delete {
1366 my ($self, $spell) = @_; 1384 my ($self, $spell) = @_;
1367} 1385}
1368 1386
1369sub conn::addme_success { 1387sub conn::addme_success {
1370 my ($self) = @_; 1388 my ($self) = @_;
1371 1389
1390 $MAPWIDGET->clr_commands;
1391
1372 for my $skill (values %{$self->{skill_info}}) { 1392 for my $skill (values %{$self->{skill_info}}) {
1373 $MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'"); 1393 $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'"); 1394 $MAPWIDGET->add_command ("use_skill $skill", CFClient::UI::Label::escape "Immediately use the skill '$skill'");
1375 } 1395 }
1376 1396
1377 $MAPWIDGET->add_command ("pet\\_mode defend", "Tell pets to stay close to you and defend you"); 1397 $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"); 1398 $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"); 1399 $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"); 1400 $MAPWIDGET->add_command ("killpets", "Kill your pets");
1401 $MAPWIDGET->add_command ("chat", "chat TEXT\nChat with all other players");
1402 $MAPWIDGET->add_command ("shout", "shout TEXT\nShout loudly, used for emergencies");
1403 $MAPWIDGET->add_command ("tell", "tell USERNAME TEXT\nPrivately tell a specific player");
1404
1405 my $parser = new Pod::POM;
1406 my $pod = $parser->parse_file (CFClient::find_rcfile "pod/command_help.pod");
1407
1408 for my $head2 ($pod->head2) {
1409 $head2->title =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x
1410 or next;
1411
1412 my $cmd = $1;
1413 my @args = split /\|/, $2;
1414 @args = (".*") unless @args;
1415
1416 my $text = CFClient::pod_to_pango $head2;
1417
1418 for my $arg (@args) {
1419 $arg = $arg eq ".*" ? "" : " $arg";
1420
1421 $MAPWIDGET->add_command ("$cmd$arg", $text);
1422 }
1423 }
1381} 1424}
1382 1425
1383sub conn::eof { 1426sub conn::eof {
1427 $MAPWIDGET->clr_commands;
1428
1384 stop_game; 1429 stop_game;
1385} 1430}
1386 1431
1387sub update_floorbox { 1432sub update_floorbox {
1388 $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub { 1433 $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
… …
1406} 1451}
1407 1452
1408sub conn::container_add { 1453sub conn::container_add {
1409 my ($self, $tag, $items) = @_; 1454 my ($self, $tag, $items) = @_;
1410 1455
1411 print "container_add on conainer $tag (player: $self->{player}{tag})\n"; 1456 #d# print "container_add: container $tag ($self->{player}{tag})\n";
1412 1457
1413 if ($tag == 0) { 1458 if ($tag == 0) {
1414 update_floorbox; 1459 update_floorbox;
1460 $OPENCONT = 0;
1461 $INVR_LBL->set_text ("Floor");
1415 $INVR->set_items ($self->{container}{0}); 1462 $INVR->set_items ($self->{container}{0});
1416 $OPENCONT = 0;
1417 } elsif ($tag == $self->{player}{tag}) { 1463 } elsif ($tag == $self->{player}{tag}) {
1464 $INVR_LBL->set_text ("Player");
1418 $INV->set_items ($self->{container}{$self->{player}{tag}}) 1465 $INV->set_items ($self->{container}{$self->{player}{tag}})
1419 } else { 1466 } else {
1420 $OPENCONT = $tag; 1467 $OPENCONT = $tag;
1468 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1421 $INVR->set_items ($self->{container}{$tag}); 1469 $INVR->set_items ($self->{container}{$tag});
1422 } 1470 }
1423 1471
1424 # $self-<{player}{tag} => player inv 1472 # $self-<{player}{tag} => player inv
1425 #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}}; 1473 #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1426} 1474}
1427 1475
1428sub conn::container_clear { 1476sub conn::container_clear {
1429 my ($self, $tag) = @_; 1477 my ($self, $tag) = @_;
1430 1478
1431 print "container_clear on conainer $tag (player: $self->{player}{tag})\n"; 1479 #d# print "container_clear: container $tag ($self->{player}{tag})\n";
1432 1480
1433 if ($tag == 0) { 1481 if ($tag == 0) {
1434 update_floorbox; 1482 update_floorbox;
1483 $OPENCONT = 0;
1484 $INVR_LBL->set_text ("Floor");
1435 $INVR->set_items ($self->{container}{0}); 1485 $INVR->set_items ($self->{container}{0});
1436 $OPENCONT = 0;
1437 } elsif ($tag == $self->{player}{tag}) { 1486 } elsif ($tag == $self->{player}{tag}) {
1487 $INVR_LBL->set_text ("Player");
1438 $INV->set_items ($self->{container}{$tag}) 1488 $INV->set_items ($self->{container}{$tag})
1439 } else { 1489 } else {
1490 $OPENCONT = $tag;
1491 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1440 $INVR->set_items ($self->{container}{$tag}); 1492 $INVR->set_items ($self->{container}{$tag});
1441 $OPENCONT = $tag;
1442 } 1493 }
1443 1494
1444# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0}; 1495# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1445} 1496}
1446 1497
1447sub conn::item_delete { 1498sub conn::item_delete {
1448 my ($self, @items) = @_; 1499 my ($self, @items) = @_;
1449 1500
1450 for (@items) { 1501 for (@items) {
1451 print "item_delete on container $_->{container} (player: $self->{player}{tag})\n"; 1502 #d# print "item_delete: $_->{tag} from $_->{container} ($self->{player}{tag})\n";
1503
1452 if ($_->{container} == 0) { 1504 if ($_->{container} == 0) {
1453 update_floorbox; 1505 update_floorbox;
1506 $OPENCONT = 0;
1507 $INVR_LBL->set_text ("Floor");
1454 $INVR->set_items ($self->{container}{0}); 1508 $INVR->set_items ($self->{container}{0});
1455 } elsif ($_->{container} == $self->{player}{tag}) { 1509 } elsif ($_->{container} == $self->{player}{tag}) {
1510 $INVR_LBL->set_text ("Player");
1456 $INV->set_items ($self->{container}{$self->{player}{tag}}) 1511 $INV->set_items ($self->{container}{$self->{player}{tag}})
1457 } else { 1512 } else {
1513 $OPENCONT = $_->{container};
1514 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1458 $INVR->set_items ($self->{container}{0}); 1515 $INVR->set_items ($self->{container}{$_->{container}});
1459 } 1516 }
1460 } 1517 }
1461} 1518}
1462 1519
1463sub conn::item_update { 1520sub conn::item_update {
1464 my ($self, $item) = @_; 1521 my ($self, $item) = @_;
1465 1522
1466 print "item_update: container: $item->{container} (player: $self->{player}{tag})\n"; 1523 #d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($OPENCONT)\n";
1467 1524
1468 if ($item->{container} == 0) { 1525 if ($item->{tag} == $OPENCONT && not ($item->{flags} & Crossfire::Protocol::F_OPEN)) {
1469 update_floorbox; 1526 $OPENCONT = 0;
1527 $INVR_LBL->set_text ("Floor");
1470 $INVR->set_items ($self->{container}{0}); 1528 $INVR->set_items ($self->{container}{0});
1529
1530 $item->{widget}->update_item
1531 if $item->{widget};
1532 } else {
1533 if ($item->{container} == 0) {
1534 update_floorbox;
1535 $OPENCONT = 0;
1536 $INVR_LBL->set_text ("Floor");
1537 $INVR->set_items ($self->{container}{0});
1471 } elsif ($item->{container} == $self->{player}{tag}) { 1538 } elsif ($item->{container} == $self->{player}{tag}) {
1472 $INV->set_items ($self->{container}{$item->{container}}) 1539 $INV->set_items ($self->{container}{$item->{container}})
1540 }
1473 } 1541 }
1474} 1542}
1475 1543
1476%SDL_CB = ( 1544%SDL_CB = (
1477 CFClient::SDL_QUIT => sub { 1545 CFClient::SDL_QUIT => sub {
… …
1577 $FONT_FIXED = new_from_file CFClient::Font $fonts[1]; 1645 $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
1578 1646
1579 $FONT_PROP->make_default; 1647 $FONT_PROP->make_default;
1580 } 1648 }
1581 1649
1650# compare mono (ft) vs. rgba (cairo)
1651# ft - 1.8s, cairo 3s, even in alpha-only mode
1652# for my $rgba (0..1) {
1653# my $t1 = Time::HiRes::time;
1654# for (1..1000) {
1655# my $layout = CFClient::Layout->new ($rgba);
1656# $layout->set_text ("hallo" x 100);
1657# $layout->render;
1658# }
1659# my $t2 = Time::HiRes::time;
1660# warn $t2-$t1;
1661# }
1662
1582 video_init; 1663 video_init;
1583 audio_init; 1664 audio_init;
1584} 1665}
1585 1666
1586Event::loop; 1667Event::loop;

Diff Legend

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