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.227 by root, Wed May 17 20:52:12 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}
… …
741 750
742 $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 751 $CFG->{mapsize} = $self->{range}[0] = $value = int $value;
743 }, 752 },
744 ); 753 );
745 754
755 $table->add (0, 8, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");
756 $table->add (1, 8, new CFClient::UI::Entry
757 text => $CFG->{output_count},
758 tooltip => "Should be set to 1 unless you know what you are doing",
759 connect_changed => sub { $CFG->{output_count} = $_[1] },
760 );
761
762 $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");
763 $table->add (1, 9, new CFClient::UI::Entry
764 text => $CFG->{output_sync},
765 tooltip => "Should be set to 1 unless you know what you are doing",
766 connect_changed => sub { $CFG->{output_sync} = $_[1] },
767 );
768
746 $table->add (1, 8, $LOGIN_BUTTON = new CFClient::UI::Button 769 $table->add (1, 10, $LOGIN_BUTTON = new CFClient::UI::Button
747 expand => 1, 770 expand => 1,
748 align => 0, 771 align => 0,
749 text => "Login", 772 text => "Login",
750 connect_activate => sub { 773 connect_activate => sub {
751 $CONN ? stop_game 774 $CONN ? stop_game
… …
813sub make_inventory_window { 836sub make_inventory_window {
814 my $invwin = new CFClient::UI::FancyFrame 837 my $invwin = new CFClient::UI::FancyFrame
815 user_w => $WIDTH * (4/5), user_h => $HEIGHT * (4/5), title => "Inventory"; 838 user_w => $WIDTH * (4/5), user_h => $HEIGHT * (4/5), title => "Inventory";
816 839
817 $invwin->add (my $hb = new CFClient::UI::HBox); 840 $invwin->add (my $hb = new CFClient::UI::HBox);
841
842 $hb->add (my $vb1 = new CFClient::UI::VBox expand => 1);
843 $vb1->add (my $lbl = new CFClient::UI::Label);
844 $lbl->set_text ("Player");
818 $hb->add ($INV = new CFClient::UI::Inventory expand => 1); 845 $vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
846
847 $hb->add (my $vb2 = new CFClient::UI::VBox expand => 1);
848 $vb2->add ($INVR_LBL = new CFClient::UI::Label);
849 $INVR_LBL->set_text ("Floor");
819 $hb->add ($INVR = new CFClient::UI::Inventory expand => 1); 850 $vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);
820 851
821 $invwin 852 $invwin
822} 853}
823 854
824sub sdl_init { 855sub sdl_init {
… …
924my $bgmusic;#TODO#hack#d# 955my $bgmusic;#TODO#hack#d#
925 956
926sub audio_channel_finished { 957sub audio_channel_finished {
927 my ($channel) = @_; 958 my ($channel) = @_;
928 959
929 warn "channel $channel finished\n";#d# 960 #warn "channel $channel finished\n";#d#
930} 961}
931 962
932sub audio_music_finished { 963sub audio_music_finished {
933 return unless $CFG->{bgm_enable}; 964 return unless $CFG->{bgm_enable};
934 965
… …
1020 delete $animate_object{$widget}; 1051 delete $animate_object{$widget};
1021} 1052}
1022 1053
1023@conn::ISA = Crossfire::Protocol::; 1054@conn::ISA = Crossfire::Protocol::;
1024 1055
1056sub conn::new {
1057 my $class = shift;
1058
1059 my $self = $class->Crossfire::Protocol::new (@_);
1060
1061 $MAPWIDGET->clr_commands;
1062
1063 my $parser = new Pod::POM;
1064 my $pod = $parser->parse_file (CFClient::find_rcfile "pod/command_help.pod");
1065
1066 for my $head2 ($pod->head2) {
1067 $head2->title =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x
1068 or next;
1069
1070 my $cmd = $1;
1071 my @args = split /\|/, $2;
1072 @args = (".*") unless @args;
1073
1074 my $text = CFClient::pod_to_pango $head2->content;
1075
1076 for my $arg (@args) {
1077 $arg = $arg eq ".*" ? "" : " $arg";
1078
1079 $MAPWIDGET->add_command ("$cmd$arg", $text);
1080 }
1081 }
1082
1083 $self
1084}
1085
1025sub conn::stats_update { 1086sub conn::stats_update {
1026 my ($self, $stats) = @_; 1087 my ($self, $stats) = @_;
1088
1089 if (my $exp = $stats->{Crossfire::Protocol::CS_STAT_EXP64}) {
1090 my $diff = $exp - $self->{prev_exp};
1091 $STATUSBOX->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5)
1092 if exists $self->{prev_exp} && $diff;
1093 $self->{prev_exp} = $exp;
1094 }
1027 1095
1028 update_stats_window ($stats); 1096 update_stats_window ($stats);
1029} 1097}
1030 1098
1031sub conn::user_send { 1099sub conn::user_send {
… …
1330 [0.74, 0.65, 0.41], 1398 [0.74, 0.65, 0.41],
1331 ); 1399 );
1332 1400
1333 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0]; 1401 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
1334 1402
1335 $text =~ s/&/&amp;/g; $text =~ s/</&lt;/g; 1403 $text = CFClient::UI::Label::escape $text;
1336 $text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g; 1404 $text =~ s/\[b\](.*?)\[\/b\]/<b>\1<\/b>/g;
1337 $text =~ s/\[color=(.*?)\](.*?)\[\/color\]/<span foreground='\1'>\2<\/span>/g; 1405 $text =~ s/\[color=(.*?)\](.*?)\[\/color\]/<span foreground='\1'>\2<\/span>/g;
1338 1406
1339 $LOGVIEW->add_paragraph ($color[$color], 1407 $LOGVIEW->add_paragraph ($color[$color],
1340 join "\n", map "$time $_", split /\n/, $text); 1408 join "\n", map "$time $_", split /\n/, $text);
… …
1356sub conn::spell_add { 1424sub conn::spell_add {
1357 my ($self, $spell) = @_; 1425 my ($self, $spell) = @_;
1358 1426
1359 # TODO 1427 # TODO
1360 # create a widget dynamically, using spell face (CF::Protocol downloads them) 1428 # create a widget dynamically, using spell face (CF::Protocol downloads them)
1361 $MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message}); 1429 $MAPWIDGET->add_command ("invoke $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1362 $MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message}); 1430 $MAPWIDGET->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message});
1363} 1431}
1364 1432
1365sub conn::spell_delete { 1433sub conn::spell_delete {
1366 my ($self, $spell) = @_; 1434 my ($self, $spell) = @_;
1367} 1435}
1368 1436
1369sub conn::addme_success { 1437sub conn::addme_success {
1370 my ($self) = @_; 1438 my ($self) = @_;
1371 1439
1440 $self->send ("command output-sync $CFG->{output_sync}");
1441 $self->send ("command output-count $CFG->{output_count}");
1442
1372 for my $skill (values %{$self->{skill_info}}) { 1443 for my $skill (values %{$self->{skill_info}}) {
1373 $MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'"); 1444 $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'"); 1445 $MAPWIDGET->add_command ("use_skill $skill", CFClient::UI::Label::escape "Immediately use the skill '$skill'");
1375 } 1446 }
1376
1377 $MAPWIDGET->add_command ("pet\\_mode 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");
1379 $MAPWIDGET->add_command ("pet\\_mode sad", "Search &amp; Destroy - tell pets to roam about and attack enemies");
1380 $MAPWIDGET->add_command ("kill\\_pets", "kill your pets");
1381} 1447}
1382 1448
1383sub conn::eof { 1449sub conn::eof {
1450 $MAPWIDGET->clr_commands;
1451
1384 stop_game; 1452 stop_game;
1385} 1453}
1386 1454
1387sub update_floorbox { 1455sub update_floorbox {
1388 $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub { 1456 $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
… …
1406} 1474}
1407 1475
1408sub conn::container_add { 1476sub conn::container_add {
1409 my ($self, $tag, $items) = @_; 1477 my ($self, $tag, $items) = @_;
1410 1478
1411 print "container_add on conainer $tag (player: $self->{player}{tag})\n"; 1479 #d# print "container_add: container $tag ($self->{player}{tag})\n";
1412 1480
1413 if ($tag == 0) { 1481 if ($tag == 0) {
1414 update_floorbox; 1482 update_floorbox;
1483 $OPENCONT = 0;
1484 $INVR_LBL->set_text ("Floor");
1415 $INVR->set_items ($self->{container}{0}); 1485 $INVR->set_items ($self->{container}{0});
1416 $OPENCONT = 0;
1417 } elsif ($tag == $self->{player}{tag}) { 1486 } elsif ($tag == $self->{player}{tag}) {
1487 $INVR_LBL->set_text ("Player");
1418 $INV->set_items ($self->{container}{$self->{player}{tag}}) 1488 $INV->set_items ($self->{container}{$self->{player}{tag}})
1419 } else { 1489 } else {
1420 $OPENCONT = $tag; 1490 $OPENCONT = $tag;
1491 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1421 $INVR->set_items ($self->{container}{$tag}); 1492 $INVR->set_items ($self->{container}{$tag});
1422 } 1493 }
1423 1494
1424 # $self-<{player}{tag} => player inv 1495 # $self-<{player}{tag} => player inv
1425 #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}}; 1496 #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
1426} 1497}
1427 1498
1428sub conn::container_clear { 1499sub conn::container_clear {
1429 my ($self, $tag) = @_; 1500 my ($self, $tag) = @_;
1430 1501
1431 print "container_clear on conainer $tag (player: $self->{player}{tag})\n"; 1502 #d# print "container_clear: container $tag ($self->{player}{tag})\n";
1432 1503
1433 if ($tag == 0) { 1504 if ($tag == 0) {
1434 update_floorbox; 1505 update_floorbox;
1506 $OPENCONT = 0;
1507 $INVR_LBL->set_text ("Floor");
1435 $INVR->set_items ($self->{container}{0}); 1508 $INVR->set_items ($self->{container}{0});
1436 $OPENCONT = 0;
1437 } elsif ($tag == $self->{player}{tag}) { 1509 } elsif ($tag == $self->{player}{tag}) {
1510 $INVR_LBL->set_text ("Player");
1438 $INV->set_items ($self->{container}{$tag}) 1511 $INV->set_items ($self->{container}{$tag})
1439 } else { 1512 } else {
1513 $OPENCONT = $tag;
1514 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1440 $INVR->set_items ($self->{container}{$tag}); 1515 $INVR->set_items ($self->{container}{$tag});
1441 $OPENCONT = $tag;
1442 } 1516 }
1443 1517
1444# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0}; 1518# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
1445} 1519}
1446 1520
1447sub conn::item_delete { 1521sub conn::item_delete {
1448 my ($self, @items) = @_; 1522 my ($self, @items) = @_;
1449 1523
1450 for (@items) { 1524 for (@items) {
1451 print "item_delete on container $_->{container} (player: $self->{player}{tag})\n"; 1525 #d# print "item_delete: $_->{tag} from $_->{container} ($self->{player}{tag})\n";
1526
1452 if ($_->{container} == 0) { 1527 if ($_->{container} == 0) {
1453 update_floorbox; 1528 update_floorbox;
1529 $OPENCONT = 0;
1530 $INVR_LBL->set_text ("Floor");
1454 $INVR->set_items ($self->{container}{0}); 1531 $INVR->set_items ($self->{container}{0});
1455 } elsif ($_->{container} == $self->{player}{tag}) { 1532 } elsif ($_->{container} == $self->{player}{tag}) {
1533 $INVR_LBL->set_text ("Player");
1456 $INV->set_items ($self->{container}{$self->{player}{tag}}) 1534 $INV->set_items ($self->{container}{$self->{player}{tag}})
1457 } else { 1535 } else {
1536 $OPENCONT = $_->{container};
1537 $INVR_LBL->set_text (CFClient::UI::InventoryItem::_item_to_desc ($self->{item}->{$OPENCONT}));
1458 $INVR->set_items ($self->{container}{0}); 1538 $INVR->set_items ($self->{container}{$_->{container}});
1459 } 1539 }
1460 } 1540 }
1461} 1541}
1462 1542
1463sub conn::item_update { 1543sub conn::item_update {
1464 my ($self, $item) = @_; 1544 my ($self, $item) = @_;
1465 1545
1466 print "item_update: container: $item->{container} (player: $self->{player}{tag})\n"; 1546 #d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($OPENCONT)\n";
1467 1547
1468 if ($item->{container} == 0) { 1548 if ($item->{tag} == $OPENCONT && not ($item->{flags} & Crossfire::Protocol::F_OPEN)) {
1469 update_floorbox; 1549 $OPENCONT = 0;
1550 $INVR_LBL->set_text ("Floor");
1470 $INVR->set_items ($self->{container}{0}); 1551 $INVR->set_items ($self->{container}{0});
1552
1553 $item->{widget}->update_item
1554 if $item->{widget};
1555 } else {
1556 if ($item->{container} == 0) {
1557 update_floorbox;
1558 $OPENCONT = 0;
1559 $INVR_LBL->set_text ("Floor");
1560 $INVR->set_items ($self->{container}{0});
1471 } elsif ($item->{container} == $self->{player}{tag}) { 1561 } elsif ($item->{container} == $self->{player}{tag}) {
1472 $INV->set_items ($self->{container}{$item->{container}}) 1562 $INV->set_items ($self->{container}{$item->{container}})
1563 }
1473 } 1564 }
1474} 1565}
1475 1566
1476%SDL_CB = ( 1567%SDL_CB = (
1477 CFClient::SDL_QUIT => sub { 1568 CFClient::SDL_QUIT => sub {
… …
1539 host => "crossfire.schmorp.de", 1630 host => "crossfire.schmorp.de",
1540 say_command => 'say', 1631 say_command => 'say',
1541 audio_enable => 1, 1632 audio_enable => 1,
1542 bgm_enable => 1, 1633 bgm_enable => 1,
1543 bgm_volume => 0.25, 1634 bgm_volume => 0.25,
1635 output_sync => 1,
1636 output_count => 1,
1544 ); 1637 );
1545 1638
1546 while (my ($k, $v) = each %DEF_CFG) { 1639 while (my ($k, $v) = each %DEF_CFG) {
1547 $CFG->{$k} = $v unless exists $CFG->{$k}; 1640 $CFG->{$k} = $v unless exists $CFG->{$k};
1548 } 1641 }
… …
1577 $FONT_FIXED = new_from_file CFClient::Font $fonts[1]; 1670 $FONT_FIXED = new_from_file CFClient::Font $fonts[1];
1578 1671
1579 $FONT_PROP->make_default; 1672 $FONT_PROP->make_default;
1580 } 1673 }
1581 1674
1675# compare mono (ft) vs. rgba (cairo)
1676# ft - 1.8s, cairo 3s, even in alpha-only mode
1677# for my $rgba (0..1) {
1678# my $t1 = Time::HiRes::time;
1679# for (1..1000) {
1680# my $layout = CFClient::Layout->new ($rgba);
1681# $layout->set_text ("hallo" x 100);
1682# $layout->render;
1683# }
1684# my $t2 = Time::HiRes::time;
1685# warn $t2-$t1;
1686# }
1687
1582 video_init; 1688 video_init;
1583 audio_init; 1689 audio_init;
1584} 1690}
1585 1691
1586Event::loop; 1692Event::loop;
… …
1640 1746
1641Typing B<climb> will display a list of commands with I<climb> in their 1747Typing B<climb> will display a list of commands with I<climb> in their
1642name, such as I<ready_skill climbing> and I<use_skill climbing>. 1748name, such as I<ready_skill climbing> and I<use_skill climbing>.
1643 1749
1644You can abbreviate commands by typing only the first character of every 1750You can abbreviate commands by typing only the first character of every
1645word. For example, typing I<iwor> will likely select I<invoke word of 1751word (or even characters within the word - the client will try to make
1646recall>, while I<ccfo> will select I<cast create food>. Likewise, I<rscli> 1752a good guess, as long as the characters are in order). For example,
1647will likely select I<ready_skill climbing> and I<usl> will give you 1753typing I<iwor> will likely select I<invoke word of recall>, while I<ccfo>
1648I<use_skill levitation>. 1754will select I<cast create food>. Likewise, I<rscli> will likely select
1755I<ready_skill climbing> and I<usl> will give you I<use_skill levitation>.
1756
1757You can enter space and other text as arguemnt to the command. For
1758example, C<cfoo waybread> will expand to C<cast create food waybread>.
1649 1759
1650=head2 The map overview 1760=head2 The map overview
1651 1761
1652#TODO# 1762#TODO#
1653 1763

Diff Legend

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