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

Comparing deliantra/Deliantra-Client/bin/cfplus (file contents):
Revision 1.98 by root, Sat Jul 22 13:20:33 2006 UTC vs.
Revision 1.103 by root, Mon Jul 24 08:23:28 2006 UTC

… …
36 36
37use CFClient; 37use CFClient;
38use CFClient::OpenGL (); 38use CFClient::OpenGL ();
39use CFClient::Protocol; 39use CFClient::Protocol;
40use CFClient::UI; 40use CFClient::UI;
41use CFClient::Pod;
41use CFClient::BindingEditor; 42use CFClient::BindingEditor;
42use CFClient::MapWidget; 43use CFClient::MapWidget;
43 44
44$SIG{QUIT} = sub { Carp::cluck "QUIT" }; 45$SIG{QUIT} = sub { Carp::cluck "QUIT" };
45$SIG{PIPE} = 'IGNORE'; 46$SIG{PIPE} = 'IGNORE';
46 47
48$Event::Eval = 0;
47$Event::DIED = sub { 49$Event::DIED = sub {
48 # TODO: display dialog box or so 50 # TODO: display dialog box or so
49 Carp::confess $_[1];#d#TODO: remove when stable 51 Carp::cluck $_[1];#d#TODO: remove when stable
50 CFClient::error $_[1]; 52 CFClient::error $_[1];
51}; 53};
52 54
53#$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d# 55$SIG{__DIE__} = sub {
56 return if CFClient::in_destruct;
57 Carp::cluck $_[0];
58 CFClient::error $_[0];
59 return;#d#
60 #return unless defined $^S && !$^S;
61 $Event::DIED->(undef, $_[0]);
62};
54 63
55our $VERSION = '0.1'; 64our $VERSION = '0.1';
56 65
57my $MAX_FPS = 60; 66my $MAX_FPS = 60;
58my $MIN_FPS = 5; # unused as of yet 67my $MIN_FPS = 5; # unused as of yet
… …
130our $BIND_UPD_CB; 139our $BIND_UPD_CB;
131 140
132our $PICKUP_CFG; 141our $PICKUP_CFG;
133 142
134sub status { 143sub status {
135 $STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]); 144 $STATUSBOX->add (CFClient::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
136} 145}
137 146
138sub debug { 147sub debug {
139 $DEBUG_STATUS->set_text ($_[0]); 148 $DEBUG_STATUS->set_text ($_[0]);
140} 149}
… …
251 0 260 0
252 }, 261 },
253 ); 262 );
254 263
255 # center: swap stats 264 # center: swap stats
256 my ($sw1, $sw2) = map +(new CFClient::UI::Combobox 265 my ($sw1, $sw2) = map +(new CFClient::UI::Selector
257 expand => 1, 266 expand => 1,
258 value => $_, 267 value => $_,
259 options => [ 268 options => [
260 [1 => "Str", "Strength ($conn->{stat}{+CS_STAT_STR})"], 269 [1 => "Str", "Strength ($conn->{stat}{+CS_STAT_STR})"],
261 [2 => "Dex", "Dexterity ($conn->{stat}{+CS_STAT_DEX})"], 270 [2 => "Dex", "Dexterity ($conn->{stat}{+CS_STAT_DEX})"],
… …
686 can_hover => 1, can_events => 1, 695 can_hover => 1, can_events => 1,
687 tooltip => "The weight of the player including all inventory items."); 696 tooltip => "The weight of the player including all inventory items.");
688 $hb0->add ($STATWIDS->{m_weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1, 697 $hb0->add ($STATWIDS->{m_weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1,
689 can_hover => 1, can_events => 1, 698 can_hover => 1, can_events => 1,
690 tooltip => "The weight limit: you cannot carry more than this."); 699 tooltip => "The weight limit: you cannot carry more than this.");
691
692 700
693 $vb->add (my $hb = new CFClient::UI::HBox expand => 1); 701 $vb->add (my $hb = new CFClient::UI::HBox expand => 1);
694 $hb->add (my $tbl = new CFClient::UI::Table expand => 1); 702 $hb->add (my $tbl = new CFClient::UI::Table expand => 1);
695 703
696 my $color2 = [1, 1, 0]; 704 my $color2 = [1, 1, 0];
… …
1132 $QUIT_DIALOG = new CFClient::UI::FancyFrame 1140 $QUIT_DIALOG = new CFClient::UI::FancyFrame
1133 x => "center", 1141 x => "center",
1134 y => "center", 1142 y => "center",
1135 z => 50, 1143 z => 50,
1136 title => "Really Quit?", 1144 title => "Really Quit?",
1145 on_key_down => sub {
1146 my ($dialog, $ev) = @_;
1147 $ev->{sym} == 27 and $dialog->hide;
1148 }
1137 ; 1149 ;
1138 1150
1139 $QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1); 1151 $QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);
1140 1152
1141 $vb->add (new CFClient::UI::Label 1153 $vb->add (new CFClient::UI::Label
… …
1155 on_activate => sub { exit }, 1167 on_activate => sub { exit },
1156 ); 1168 );
1157 } 1169 }
1158 1170
1159 $QUIT_DIALOG->show; 1171 $QUIT_DIALOG->show;
1172 $QUIT_DIALOG->grab_focus;
1160} 1173}
1161 1174
1162sub autopickup_setup { 1175sub autopickup_setup {
1163 my $table = new CFClient::UI::Table; 1176 my $table = new CFClient::UI::Table;
1164 1177
… …
1254 }); 1267 });
1255 1268
1256 $table 1269 $table
1257} 1270}
1258 1271
1272my %SORT_ORDER = (
1273 type => undef,
1274 mtime => sub { sort {
1275 ($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED)
1276 or $b->{mtime} <=> $a->{mtime}
1277 or $a->{type} <=> $b->{type}
1278 } @_ },
1279 weight => sub { sort {
1280 $a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1)
1281 or $a->{type} <=> $b->{type}
1282 } @_ },
1283);
1284
1259sub inventory_widget { 1285sub inventory_widget {
1260 my $hb = new CFClient::UI::HBox homogeneous => 1; 1286 my $hb = new CFClient::UI::HBox homogeneous => 1;
1261 1287
1262 $hb->add (my $vb1 = new CFClient::UI::VBox); 1288 $hb->add (my $vb1 = new CFClient::UI::VBox);
1263 $vb1->add (new CFClient::UI::Label align => 0, text => "Player"); 1289 $vb1->add (new CFClient::UI::Label align => 0, text => "Player");
1290
1291 $vb1->add (my $hb1 = new CFClient::UI::HBox);
1292
1293 use sort 'stable';
1294
1295 $hb1->add (new CFClient::UI::Selector
1296 value => $::CFG->{inv_sort},
1297 options => [
1298 [type => "Type/Name"],
1299 [mtime => "Recent/Normal/Locked"],
1300 [weight => "Weight/Type"],
1301 ],
1302 on_changed => sub {
1303 $::CFG->{inv_sort} = $_[1];
1304 $INV->set_sort_order ($SORT_ORDER{$_[1]});
1305 },
1306 );
1307 $hb1->add (new CFClient::UI::Label text => "Weight: ", align => 1, expand => 1);
1308 #TODO# update to weigh/maxweight
1309 $hb1->add ($STATWIDS->{i_weight} = new CFClient::UI::Label align => -1);
1310
1264 $vb1->add (my $sw1 = new CFClient::UI::ScrolledWindow expand => 1, scroll_y => 1); 1311 $vb1->add (my $sw1 = new CFClient::UI::ScrolledWindow expand => 1, scroll_y => 1);
1265 $sw1->add ($INV = new CFClient::UI::Inventory); 1312 $sw1->add ($INV = new CFClient::UI::Inventory);
1266 1313
1267 $hb->add (my $vb2 = new CFClient::UI::VBox); 1314 $hb->add (my $vb2 = new CFClient::UI::VBox);
1268 1315
… …
1440 $refresh->(); 1487 $refresh->();
1441 1488
1442 $vb 1489 $vb
1443} 1490}
1444 1491
1445# just weirdness, pls. ignore
1446sub load_html_page {
1447 my ($viewer, $base) = @_;
1448
1449 $viewer->clear;
1450
1451 require LWP::Simple;
1452 require HTML::Parser;
1453 require URI;
1454
1455 my $page = LWP::Simple::get ($base)
1456 or return;
1457
1458 my @s = { };
1459 my %passthrough = map ($_ => undef), qw(b i u s tt big small sub sup);
1460
1461 my $parser = HTML::Parser->new (
1462 text_h => [sub {
1463 my ($text) = @_;
1464 $text =~ s/\s+/ /g;
1465 $s[-1]{text} .= CFClient::UI::Label::escape $text;
1466 }, "dtext"],
1467 start_h => [sub {
1468 my ($tag, $attr) = @_;
1469 if ($passthrough{$tag}) {
1470 $s[-1]{text} .= "<$tag>";
1471 } elsif ($tag eq "h1") {
1472 push @s, { text => "<span foreground='#ffff00' size='x-large'>" };
1473 } elsif ($tag eq "h2") {
1474 push @s, { text => "<span foreground='#ccccff' size='large'>" };
1475 } elsif ($tag eq "h3") {
1476 push @s, { text => "<span size='large'>" };
1477 } elsif ($tag eq "a") {
1478 push @s, { text => "", url => $attr->{href} };
1479 } elsif ($tag eq "p") {
1480 push @s, { };
1481 } elsif ($tag eq "img") {
1482 eval {
1483 push @{$s[-1]{obj}}, new CFClient::UI::Image
1484 tex => (new_from_image CFClient::Texture LWP::Simple::get (URI->new ($attr->{src}, $base)->abs ($base)));
1485 $s[-1]{text} .= "\x{fffc}";
1486 };
1487 }
1488 }, "tagname, attr"],
1489 end_h => [sub {
1490 my ($tag) = @_;
1491 if ($passthrough{$tag}) {
1492 $s[-1]{text} .= "</$tag>";
1493 } elsif ($tag =~ /^h\d$/) {
1494 $s[-1]{text} .= "</span>";
1495 push @s, { };
1496 } elsif ($tag eq "a") {
1497 my $S = pop @s;
1498 $s[-1]{text} .= "\x{fffc}";
1499 push @{$s[-1]{obj}}, new CFClient::UI::Label
1500 fg => [0.8, 0.8, 1],
1501 markup => "<u>$S->{text}</u>",
1502 fontsize => 0.8,
1503 can_events => 1,
1504 can_focus => 1,
1505 on_button_up => sub {
1506 load_html_page ($viewer, URI->new ($S->{url}, $base)->abs ($base));
1507 },
1508 ;
1509 }
1510 }, "tagname"],
1511 );
1512
1513 $parser->parse ($page);
1514 $parser->eof;
1515
1516 $viewer->add_paragraph ([1, 1, 1, 1], [$_->{text}, @{ $_->{obj} || [] }], $_->{indent})
1517 for @s;
1518
1519 $viewer->set_offset (0);
1520}
1521
1522sub help_window { 1492sub help_window {
1523 my $win = new CFClient::UI::FancyFrame 1493 my $win = new CFClient::UI::FancyFrame
1524 x => 'center', 1494 x => 'center',
1525 y => 'center', 1495 y => 'center',
1526 z => 2, 1496 z => 2,
… …
1535 $vbox->add (my $buttons = new CFClient::UI::HBox); 1505 $vbox->add (my $buttons = new CFClient::UI::HBox);
1536 $vbox->add (my $viewer = new CFClient::UI::TextScroller 1506 $vbox->add (my $viewer = new CFClient::UI::TextScroller
1537 expand => 1, fontsize => 0.8, padding_x => 4); 1507 expand => 1, fontsize => 0.8, padding_x => 4);
1538 1508
1539 $buttons->add (new CFClient::UI::Label text => "Choose a document to display: "); 1509 $buttons->add (new CFClient::UI::Label text => "Choose a document to display: ");
1540 $buttons->add (my $combo = new CFClient::UI::Combobox 1510 $buttons->add (my $combo = new CFClient::UI::Selector
1541 value => undef, 1511 value => undef,
1542 options => [ 1512 options => [
1543 [intro => "Introduction"], 1513 [intro => "Introduction"],
1544 [manual => "Main Manual"], 1514 [manual => "Main Manual"],
1545 [skill_help => "Skill Reference"], 1515 [skill_help => "Skill Reference"],
1546 [command_help => "Command Reference"], 1516 [command_help => "Command Reference"],
1547 [dmcommand_help => "DM Commands"], 1517 [dmcommand_help => "DM Commands"],
1548 [COPYING => "License Terms"], 1518 [COPYING => "License Terms"],
1549 [test => "test (do not select)"], #d#TODO
1550 ], 1519 ],
1551 on_changed => sub { 1520 on_changed => sub {
1552 my ($self, $pod) = @_; 1521 my ($self, $pod) = @_;
1553 1522
1554 if ($pod eq "test") {#d#TODO
1555 eval {
1556 load_html_page $viewer, "http://crossfire.real-time.com/guides/walkthrough/newbie-tower.html";
1557 };
1558 warn "$@" if $@;
1559 return;
1560 }
1561
1562 my $pom = CFClient::load_pod CFClient::find_rcfile "pod/$pod.pod",
1563 doc_viewer => 1, sub { CFClient::pod_to_pango_list $_[0] };
1564
1565 $viewer->clear; 1523 $viewer->clear;
1566 1524 $viewer->add_paragraph (@{ CFClient::Pod::pod_paragraphs $pod });
1567# $viewer->add_paragraph ([1, 1, 1, 1], ["<big>Test</big>\n\n \x{fffc} \x{fffc}\n",
1568# (new CFClient::UI::Image path => "x.png", can_hover => 1, can_events => 1),
1569# (new CFClient::UI::Label text => "üüüü", can_hover => 1, can_events => 1, tooltip => "??"),
1570# ]);#d#
1571
1572 $viewer->add_paragraph ([1, 1, 1, 1], $_->[1], $_->[0])
1573 for @$pom;
1574
1575 $viewer->set_offset (0); 1525 $viewer->set_offset (0);
1576 1526
1577 0 1527 0
1578 }, 1528 },
1579 on_visibility_change => sub { 1529 on_visibility_change => sub {
… …
1843 1793
1844 $WANT_REFRESH = 0; 1794 $WANT_REFRESH = 0;
1845 $CAN_REFRESH = 0; 1795 $CAN_REFRESH = 0;
1846 $LAST_REFRESH = $NOW; 1796 $LAST_REFRESH = $NOW;
1847 1797
18480 && do {
1849 # some weird model-drawing code, just a joke right now
1850 use CFClient::OpenGL;
1851
1852 $demo{t}{eye_auv} ||= new_from_file CFClient::Texture "eye2.png" or die;
1853 $demo{t}{body_auv} ||= new_from_file CFClient::Texture "body_auv3.png" or die;
1854 $demo{r} ||= do {
1855 my $mod = Compress::LZF::sthaw do { local $/; open my $fh, "<:raw:perlio", "dread.lz3"; <$fh> };
1856 $mod->{v} = pack "f*", @{$mod->{v}};
1857 $_ = [scalar @$_, pack "S!*", @$_]
1858 for values %{$mod->{g}};
1859 $mod
1860 };
1861
1862 my $r = $demo{r} or die;
1863
1864 glDepthMask 1;
1865 glClear GL_DEPTH_BUFFER_BIT;
1866 glEnable GL_TEXTURE_2D;
1867 glEnable GL_DEPTH_TEST;
1868 glEnable GL_CULL_FACE;
1869 glShadeModel $::FAST ? GL_FLAT : GL_SMOOTH;
1870
1871 glMatrixMode GL_PROJECTION;
1872 glLoadIdentity;
1873 glFrustum -1 * ($::WIDTH / $::HEIGHT), 1 * ($::WIDTH / $::HEIGHT), 1, -1, 1, 10000;
1874 #glOrtho 0, $::WIDTH, 0, $::HEIGHT, -10000, 10000;
1875 glMatrixMode GL_MODELVIEW;
1876 glLoadIdentity;
1877
1878 glPushMatrix;
1879 glTranslate 0, 0, -800;
1880 glScale 1, -1, 1;
1881 glRotate $NOW * 1000 % 36000 / 5, 0, 1, 0;
1882 glRotate $NOW * 1000 % 36000 / 6, 1, 0, 0;
1883 glRotate $NOW * 1000 % 36000 / 7, 0, 0, 1;
1884 glScale 50, 50, 50;
1885
1886 glInterleavedArrays GL_T2F_N3F_V3F, 0, $r->{v};
1887 while (my ($k, $v) = each %{$r->{g}}) {
1888 glBindTexture GL_TEXTURE_2D, ($demo{t}{$k}{name} or die);
1889 glDrawElements GL_TRIANGLES, $v->[0], GL_UNSIGNED_SHORT, $v->[1];
1890 }
1891
1892 glPopMatrix;
1893
1894 glShadeModel GL_FLAT;
1895 glDisable GL_DEPTH_TEST;
1896 glDisable GL_TEXTURE_2D;
1897 glDepthMask 0;
1898
1899 $WANT_REFRESH++;
1900};
1901
1902 CFClient::SDL_GL_SwapBuffers; 1798 CFClient::SDL_GL_SwapBuffers;
1903} 1799}
1904 1800
1905my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub { 1801my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub {
1906 $NOW = time; 1802 $NOW = time;
… …
1977############################################################################# 1873#############################################################################
1978 1874
1979$SIG{INT} = $SIG{TERM} = sub { exit }; 1875$SIG{INT} = $SIG{TERM} = sub { exit };
1980 1876
1981{ 1877{
1982 local $SIG{__DIE__} = sub {
1983 return unless defined $^S && !$^S;
1984 Carp::confess $_[0];#d#TODO: remove when stable
1985 CFClient::fatal $_[0];
1986 };
1987
1988 CFClient::read_cfg "$Crossfire::VARDIR/cfplusrc"; 1878 CFClient::read_cfg "$Crossfire::VARDIR/cfplusrc";
1989 CFClient::UI::set_layout ($::CFG->{layout}); 1879 CFClient::UI::set_layout ($::CFG->{layout});
1990 1880
1991 my %DEF_CFG = ( 1881 my %DEF_CFG = (
1992 sdl_mode => 0, 1882 sdl_mode => 0,
… …
2010 bgm_volume => 0.25, 1900 bgm_volume => 0.25,
2011 face_prefetch => 0, 1901 face_prefetch => 0,
2012 output_sync => 1, 1902 output_sync => 1,
2013 output_count => 1, 1903 output_count => 1,
2014 pickup => 0, 1904 pickup => 0,
1905 inv_sort => "mtime",
2015 default => "profile", # default profile 1906 default => "profile", # default profile
2016 ); 1907 );
2017 1908
2018 while (my ($k, $v) = each %DEF_CFG) { 1909 while (my ($k, $v) = each %DEF_CFG) {
2019 $CFG->{$k} = $v unless exists $CFG->{$k}; 1910 $CFG->{$k} = $v unless exists $CFG->{$k};

Diff Legend

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