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.120 by root, Sun Oct 1 14:48:51 2006 UTC vs.
Revision 1.131 by root, Sun Nov 19 20:31:29 2006 UTC

1#!/opt/bin/perl 1#!/opt/bin/perl
2
3my $startup_done = sub { };
4
5# do splash-screen thingy on win32
6BEGIN {
7 if (%PAR::LibCache && $^O eq "MSWin32") {
8 while (my ($filename, $zip) = each %PAR::LibCache) {
9 $zip->extractMember ("SPLASH.bmp", "$ENV{PAR_TEMP}/SPLASH.bmp");
10 }
11
12 require Win32::GUI::SplashScreen;
13
14 Win32::GUI::SplashScreen::Show (
15 -file => "$ENV{PAR_TEMP}/SPLASH.bmp",
16 );
17
18 $startup_done = sub {
19 Win32::GUI::SplashScreen::Done (1);
20 };
21 }
22}
2 23
3use strict; 24use strict;
4use utf8; 25use utf8;
5 26
6# do things only needed for single-binary version (par) 27# do things only needed for single-binary version (par)
… …
8 if (%PAR::LibCache) { 29 if (%PAR::LibCache) {
9 @INC = grep ref, @INC; # weed out all paths except pars loader refs 30 @INC = grep ref, @INC; # weed out all paths except pars loader refs
10 31
11 while (my ($filename, $zip) = each %PAR::LibCache) { 32 while (my ($filename, $zip) = each %PAR::LibCache) {
12 for ($zip->memberNames) { 33 for ($zip->memberNames) {
13 next unless /^\/root\/(.*)/; 34 next unless /^root\/(.*)/;
14 $zip->extractMember ($_, "$ENV{PAR_TEMP}/$1") 35 $zip->extractMember ($_, "$ENV{PAR_TEMP}/$1")
15 unless -e "$ENV{PAR_TEMP}/$1"; 36 unless -e "$ENV{PAR_TEMP}/$1";
16 } 37 }
17 } 38 }
18 39
… …
51 Carp::cluck $_[1];#d#TODO: remove when stable 72 Carp::cluck $_[1];#d#TODO: remove when stable
52 return;#d# 73 return;#d#
53 CFPlus::fatal ($_[1]); 74 CFPlus::fatal ($_[1]);
54}; 75};
55 76
56our $VERSION = '0.9';
57
58my $MAX_FPS = 60; 77my $MAX_FPS = 60;
59my $MIN_FPS = 5; # unused as of yet 78my $MIN_FPS = 5; # unused as of yet
60 79
61our $META_SERVER = "crossfire.real-time.com:13326"; 80our $META_SERVER = "http://metaserver.schmorp.de/current.json";
62 81
63our $LAST_REFRESH; 82our $LAST_REFRESH;
64our $NOW; 83our $NOW;
65 84
66our $CFG; 85our $CFG;
… …
104 123
105our $INVENTORY_PAGE; 124our $INVENTORY_PAGE;
106our $STATS_PAGE; 125our $STATS_PAGE;
107our $SKILL_PAGE; 126our $SKILL_PAGE;
108our $SPELL_PAGE; 127our $SPELL_PAGE;
128our $SPELL_LIST;
109 129
110our $HELP_WINDOW; 130our $HELP_WINDOW;
111our $MESSAGE_WINDOW; 131our $MESSAGE_WINDOW;
112our $FLOORBOX; 132our $FLOORBOX;
113our $GAUGES; 133our $GAUGES;
… …
137 $STATUSBOX->add (CFPlus::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]); 157 $STATUSBOX->add (CFPlus::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
138} 158}
139 159
140sub debug { 160sub debug {
141 $DEBUG_STATUS->set_text ($_[0]); 161 $DEBUG_STATUS->set_text ($_[0]);
162}
163
164sub message {
165 my ($para) = @_;
166
167 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
168
169 $para->{markup} = "<span foreground='#ffffff'>$time</span> $para->{markup}";
170
171 $LOGVIEW->add_paragraph ($para);
172 $LOGVIEW->scroll_to_bottom;
142} 173}
143 174
144sub destroy_query_dialog { 175sub destroy_query_dialog {
145 (delete $_[0]{query_dialog})->destroy 176 (delete $_[0]{query_dialog})->destroy
146 if $_[0]{query_dialog}; 177 if $_[0]{query_dialog};
… …
351 382
352 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32; 383 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
353 384
354 my ($host, $port) = split /:/, $PROFILE->{host}; 385 my ($host, $port) = split /:/, $PROFILE->{host};
355 386
356 $MAP = new CFPlus::Map $mapsize, $mapsize; 387 $MAP = new CFPlus::Map;
357 388
358 $CONN = eval { 389 $CONN = eval {
359 new CFPlus::Protocol 390 new CFPlus::Protocol
360 host => $host, 391 host => $host,
361 port => $port || 13327, 392 port => $port || 13327,
362 user => $PROFILE->{user}, 393 user => $PROFILE->{user},
363 pass => $PROFILE->{password}, 394 pass => $PROFILE->{password},
364 mapw => $mapsize, 395 mapw => $mapsize,
365 maph => $mapsize, 396 maph => $mapsize,
366 397
367 client => "cfplus $VERSION $] $^O", 398 client => "cfplus $CFPlus::VERSION $] $^O",
368 399
369 map_widget => $MAPWIDGET, 400 map_widget => $MAPWIDGET,
370 logview => $LOGVIEW, 401 logview => $LOGVIEW,
371 statusbox => $STATUSBOX, 402 statusbox => $STATUSBOX,
372 map => $MAP, 403 map => $MAP,
… …
410 destroy_query_dialog $CONN; 441 destroy_query_dialog $CONN;
411 $CONN->destroy; 442 $CONN->destroy;
412 $CONN = 0; # false, does not autovivify 443 $CONN = 0; # false, does not autovivify
413 444
414 undef $MAP; 445 undef $MAP;
415 undef $PROFILE;
416} 446}
417 447
418sub graphics_setup { 448sub graphics_setup {
419 my $vbox = new CFPlus::UI::VBox; 449 my $vbox = new CFPlus::UI::VBox;
420 450
… …
828 858
829 my $table = $METASERVER->{table}; 859 my $table = $METASERVER->{table};
830 $table->clear; 860 $table->clear;
831 $table->add (0, 0, my $label = new CFPlus::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list..."); 861 $table->add (0, 0, my $label = new CFPlus::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
832 862
833 my $buf; 863 my $ok = 0;
834 864
835 my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0; 865 CFPlus::background {
866 my $ua = CFPlus::lwp_useragent;
836 867
837 unless ($fh) { 868 CFPlus::background_msg CFPlus::from_json +(CFPlus::lwp_check $ua->get ($META_SERVER))->decoded_content;
838 $label->set_text ("unable to contact metaserver: $!"); 869 } sub {
839 return; 870 my ($msg) = @_;
840 } 871 if ($msg) {
841
842 Event->io (fd => $fh, poll => 'r', cb => sub {
843 my $res = sysread $fh, $buf, 8192, length $buf;
844
845 if (!defined $res) {
846 $_[0]->w->cancel;
847 $label->set_text ("error while retrieving server list: $!");
848 } elsif ($res == 0) {
849 $_[0]->w->cancel;
850 status "server list retrieved";
851
852 utf8::decode $buf if utf8::valid $buf;
853
854 $table->clear; 872 $table->clear;
855 873
856 my @tip = ( 874 my @tip = (
857 "The current number of users logged in on the server.", 875 "The current number of users logged in on the server.",
858 "The hostname of the server.", 876 "The hostname of the server.",
… …
868 for 0 .. $#col; 886 for 0 .. $#col;
869 887
870 my @align = qw(1 0 1 1 -1); 888 my @align = qw(1 0 1 1 -1);
871 889
872 my $y = 0; 890 my $y = 0;
873 for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) { 891 for my $m (
892 sort {
893 $b->{version} <=> $a->{version}
894 or $b->{users} <=> $a->{users}
895 }
896 @{ $msg->{servers} }
897 ) {
874 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m; 898 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) =
899 @$m{qw(ip age hostname users version description ibytes obytes uptime)};
875 900
876 for ($desc) { 901 for ($desc) {
877 s/<br>/\n/gi; 902 s/<br>/\n/gi;
878 s/<li>/\n· /gi; 903 s/<li>/\n· /gi;
879 s/<.*?>//sgi; 904 s/<.*?>//sgi;
880 s/&/&amp;/g; 905 s/&amp;/&/g;
881 s/</&lt;/g; 906 s/&lt;/</g;
882 s/>/&gt;/g; 907 s/&gt;/>/g;
883 } 908 }
884 909
885 $uptime = sprintf "%dd %02d:%02d:%02d", 910 $uptime = sprintf "%dd %02d:%02d:%02d",
886 (int $m->[8] / 86400), 911 (int $uptime / 86400),
887 (int $m->[8] / 3600) % 24, 912 (int $uptime / 3600) % 24,
888 (int $m->[8] / 60) % 60, 913 (int $uptime / 60) % 60,
889 $m->[8] % 60; 914 $uptime % 60;
890 915
891 $m = [$users, $host, $uptime, $version, $desc]; 916 $m = [$users, $host, $uptime, $version, $desc];
892 917
893 $y++; 918 $y++;
894 919
… …
904 ), 929 ),
905 (new CFPlus::UI::Empty expand => 1), 930 (new CFPlus::UI::Empty expand => 1),
906 ]); 931 ]);
907 932
908 $table->add ($_, $y, new CFPlus::UI::Label 933 $table->add ($_, $y, new CFPlus::UI::Label
934 max_w => $::WIDTH * 0.4,
909 ellipsise => 0, 935 ellipsise => 0,
910 align => $align[$_], 936 align => $align[$_],
911 text => $m->[$_], 937 text => $m->[$_],
912 tooltip => $tip[$_], 938 tooltip => $tip[$_],
939 fg => ($m->[3] =~ /\+$/ ? [1, 1, 1] : [.7, .7, .7]),
913 can_hover => 1, 940 can_hover => 1,
914 can_events => 1, 941 can_events => 1,
915 fontsize => 0.8) 942 fontsize => 0.8)
916 for 0 .. $#$m; 943 for 0 .. $#$m;
917 } 944 }
945 } else {
946 $ok or $label->set_text ("error while contacting metaserver");
918 } 947 }
919 }); 948 };
949
920} 950}
921 951
922sub metaserver_dialog { 952sub metaserver_dialog {
923 my $vbox = new CFPlus::UI::VBox; 953 my $vbox = new CFPlus::UI::VBox;
924 my $table = new CFPlus::UI::Table; 954 my $table = new CFPlus::UI::Table;
… …
928 title => "Server List", 958 title => "Server List",
929 name => 'metaserver_dialog', 959 name => 'metaserver_dialog',
930 x => 'center', 960 x => 'center',
931 y => 'center', 961 y => 'center',
932 z => 3, 962 z => 3,
963 force_w => $::WIDTH * 0.9,
933 force_h => $::HEIGHT * 0.4, 964 force_h => $::HEIGHT * 0.7,
934 child => $vbox, 965 child => $vbox,
935 has_close_button => 1, 966 has_close_button => 1,
936 table => $table, 967 table => $table,
937 on_visibility_change => sub { 968 on_visibility_change => sub {
938 update_metaserver ($_[0]) if $_[1]; 969 update_metaserver ($_[0]) if $_[1];
… …
1058 $table->add (1, 13, my $saycmd = new CFPlus::UI::CheckBox 1089 $table->add (1, 13, my $saycmd = new CFPlus::UI::CheckBox
1059 state => $CFG->{show_tips}, 1090 state => $CFG->{show_tips},
1060 tooltip => "Show the <b>Tip of the day</b> window at startup?", 1091 tooltip => "Show the <b>Tip of the day</b> window at startup?",
1061 on_changed => sub { 1092 on_changed => sub {
1062 my ($self, $value) = @_; 1093 my ($self, $value) = @_;
1063 $CFG->{shop_tips} = $value; 1094 $CFG->{show_tips} = $value;
1064 0 1095 0
1065 } 1096 }
1066 ); 1097 );
1067 1098
1068 $vbox->add (new CFPlus::UI::FancyFrame 1099 $vbox->add (new CFPlus::UI::FancyFrame
… …
1233 $table 1264 $table
1234} 1265}
1235 1266
1236my %SORT_ORDER = ( 1267my %SORT_ORDER = (
1237 type => undef, 1268 type => undef,
1238 mtime => sub { sort { 1269 mtime => sub {
1270 my $NOW = time;
1271 sort {
1272 my $atime = $a->{mtime} - $NOW; $atime = $atime < 5 * 60 ? int $atime / 60 : 6;
1273 my $btime = $b->{mtime} - $NOW; $btime = $btime < 5 * 60 ? int $btime / 60 : 6;
1274
1239 ($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED) 1275 ($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED)
1240 or $b->{mtime} <=> $a->{mtime} 1276 or $btime <=> $atime
1241 or $a->{type} <=> $b->{type} 1277 or $a->{type} <=> $b->{type}
1278 } @_
1242 } @_ }, 1279 },
1243 weight => sub { sort { 1280 weight => sub { sort {
1244 $a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1) 1281 $a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1)
1245 or $a->{type} <=> $b->{type} 1282 or $a->{type} <=> $b->{type}
1246 } @_ }, 1283 } @_ },
1247); 1284);
… …
1272 #TODO# update to weigh/maxweight 1309 #TODO# update to weigh/maxweight
1273 $hb1->add ($STATWIDS->{i_weight} = new CFPlus::UI::Label align => -1); 1310 $hb1->add ($STATWIDS->{i_weight} = new CFPlus::UI::Label align => -1);
1274 1311
1275 $vb1->add (my $sw1 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1); 1312 $vb1->add (my $sw1 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);
1276 $sw1->add ($INV = new CFPlus::UI::Inventory); 1313 $sw1->add ($INV = new CFPlus::UI::Inventory);
1314 $INV->set_sort_order ($SORT_ORDER{$::CFG->{inv_sort}});
1277 1315
1278 $hb->add (my $vb2 = new CFPlus::UI::VBox); 1316 $hb->add (my $vb2 = new CFPlus::UI::VBox);
1279 1317
1280 $vb2->add ($INV_RIGHT_HB = new CFPlus::UI::HBox); 1318 $vb2->add ($INV_RIGHT_HB = new CFPlus::UI::HBox);
1281 1319
… …
1321 $ntb->add ( 1359 $ntb->add (
1322 "Skills (F3)" => $SKILL_PAGE = skill_window, 1360 "Skills (F3)" => $SKILL_PAGE = skill_window,
1323 "Shows all your Skills." 1361 "Shows all your Skills."
1324 ); 1362 );
1325 1363
1326 my $spellsw = new CFPlus::UI::ScrolledWindow (expand => 1, scroll_y => 1); 1364 my $spellsw = $SPELL_PAGE = new CFPlus::UI::ScrolledWindow (expand => 1, scroll_y => 1);
1327 $spellsw->add ($SPELL_PAGE = new CFPlus::UI::SpellList); 1365 $spellsw->add ($SPELL_LIST = new CFPlus::UI::SpellList);
1328 $ntb->add ( 1366 $ntb->add (
1329 "Spellbook (F4)" => $spellsw, 1367 "Spellbook (F4)" => $spellsw,
1330 "Displays all spells you have and lets you edit keyboard shortcuts for them." 1368 "Displays all spells you have and lets you edit keyboard shortcuts for them."
1331 ); 1369 );
1332 $ntb->add ( 1370 $ntb->add (
… …
1883 CFPlus::Mix_AllocateChannels 8; 1921 CFPlus::Mix_AllocateChannels 8;
1884 CFPlus::MixMusic::volume $CFG->{bgm_volume} * 128; 1922 CFPlus::MixMusic::volume $CFG->{bgm_volume} * 128;
1885 1923
1886 audio_music_finished; 1924 audio_music_finished;
1887 1925
1926 local $_;
1888 while (<$fh>) { 1927 while (<$fh>) {
1889 next if /^\s*#/; 1928 next if /^\s*#/;
1890 next if /^\s*$/; 1929 next if /^\s*$/;
1891 1930
1892 my ($file, $volume, $event) = split /\s+/, $_, 3; 1931 my ($file, $volume, $event) = split /\s+/, $_, 3;
… …
2026 log_fontsize => 0.7, 2065 log_fontsize => 0.7,
2027 gauge_fontsize => 1, 2066 gauge_fontsize => 1,
2028 gauge_size => 0.35, 2067 gauge_size => 0.35,
2029 stat_fontsize => 0.7, 2068 stat_fontsize => 0.7,
2030 mapsize => 100, 2069 mapsize => 100,
2031 say_command => 'say', 2070 say_command => 'chat',
2032 audio_enable => 1, 2071 audio_enable => 1,
2033 bgm_enable => 1, 2072 bgm_enable => 1,
2034 bgm_volume => 0.25, 2073 bgm_volume => 0.25,
2035 face_prefetch => 0, 2074 face_prefetch => 0,
2036 output_sync => 1, 2075 output_sync => 1,
… …
2090# } 2129# }
2091# my $t2 = Time::HiRes::time; 2130# my $t2 = Time::HiRes::time;
2092# warn $t2-$t1; 2131# warn $t2-$t1;
2093# } 2132# }
2094 2133
2134 $startup_done->();
2135
2095 video_init; 2136 video_init;
2096 audio_init; 2137 audio_init;
2097} 2138}
2098 2139
2099show_tip_of_the_day if $CFG->{show_tips}; 2140show_tip_of_the_day if $CFG->{show_tips};
2100
2101use Data::Dumper; warn Dumper [CFPlus::win32_proxy_info()];#d#
2102 2141
2103Event::loop; 2142Event::loop;
2104#CFPlus::SDL_Quit; 2143#CFPlus::SDL_Quit;
2105#CFPlus::_exit 0; 2144#CFPlus::_exit 0;
2106 2145

Diff Legend

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