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.119 by root, Fri Sep 29 00:56:06 2006 UTC vs.
Revision 1.127 by root, Sat Nov 18 22:36:00 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;
67our $CONN; 86our $CONN;
87our $PROFILE; # current profile
68our $FAST; # fast, low-quality mode, possibly useful for software-rendering 88our $FAST; # fast, low-quality mode, possibly useful for software-rendering
69 89
70our $WANT_REFRESH; 90our $WANT_REFRESH;
71our $CAN_REFRESH; 91our $CAN_REFRESH;
72 92
… …
136 $STATUSBOX->add (CFPlus::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]); 156 $STATUSBOX->add (CFPlus::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
137} 157}
138 158
139sub debug { 159sub debug {
140 $DEBUG_STATUS->set_text ($_[0]); 160 $DEBUG_STATUS->set_text ($_[0]);
161}
162
163sub message {
164 my ($para) = @_;
165
166 my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
167
168 $para->{markup} = "<span foreground='#ffffff'>$time</span> $para->{markup}";
169
170 $LOGVIEW->add_paragraph ($para);
171 $LOGVIEW->scroll_to_bottom;
141} 172}
142 173
143sub destroy_query_dialog { 174sub destroy_query_dialog {
144 (delete $_[0]{query_dialog})->destroy 175 (delete $_[0]{query_dialog})->destroy
145 if $_[0]{query_dialog}; 176 if $_[0]{query_dialog};
… …
344 status "logging in..."; 375 status "logging in...";
345 376
346 $LOGIN_BUTTON->set_text ("Logout"); 377 $LOGIN_BUTTON->set_text ("Logout");
347 $SETUP_DIALOG->hide; 378 $SETUP_DIALOG->hide;
348 379
380 $PROFILE = $CFG->{profile}{default};
381
349 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32; 382 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
350 383
351 my ($host, $port) = split /:/, $CFG->{profile}{default}{host}; 384 my ($host, $port) = split /:/, $PROFILE->{host};
352 385
353 $MAP = new CFPlus::Map $mapsize, $mapsize; 386 $MAP = new CFPlus::Map;
354 387
355 $CONN = eval { 388 $CONN = eval {
356 new CFPlus::Protocol 389 new CFPlus::Protocol
357 host => $host, 390 host => $host,
358 port => $port || 13327, 391 port => $port || 13327,
359 user => $CFG->{profile}{default}{user}, 392 user => $PROFILE->{user},
360 pass => $CFG->{profile}{default}{password}, 393 pass => $PROFILE->{password},
361 mapw => $mapsize, 394 mapw => $mapsize,
362 maph => $mapsize, 395 maph => $mapsize,
363 396
364 client => "cfplus $VERSION $] $^O", 397 client => "cfplus $CFPlus::VERSION $] $^O",
365 398
366 map_widget => $MAPWIDGET, 399 map_widget => $MAPWIDGET,
367 logview => $LOGVIEW, 400 logview => $LOGVIEW,
368 statusbox => $STATUSBOX, 401 statusbox => $STATUSBOX,
369 map => $MAP, 402 map => $MAP,
… …
824 857
825 my $table = $METASERVER->{table}; 858 my $table = $METASERVER->{table};
826 $table->clear; 859 $table->clear;
827 $table->add (0, 0, my $label = new CFPlus::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list..."); 860 $table->add (0, 0, my $label = new CFPlus::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
828 861
829 my $buf; 862 my $ok = 0;
830 863
831 my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0; 864 CFPlus::background {
865 my $ua = CFPlus::lwp_useragent;
832 866
833 unless ($fh) { 867 CFPlus::background_msg CFPlus::from_json +(CFPlus::lwp_check $ua->get ($META_SERVER))->decoded_content;
834 $label->set_text ("unable to contact metaserver: $!"); 868 } sub {
835 return; 869 my ($msg) = @_;
836 } 870 if ($msg) {
837
838 Event->io (fd => $fh, poll => 'r', cb => sub {
839 my $res = sysread $fh, $buf, 8192, length $buf;
840
841 if (!defined $res) {
842 $_[0]->w->cancel;
843 $label->set_text ("error while retrieving server list: $!");
844 } elsif ($res == 0) {
845 $_[0]->w->cancel;
846 status "server list retrieved";
847
848 utf8::decode $buf if utf8::valid $buf;
849
850 $table->clear; 871 $table->clear;
851 872
852 my @tip = ( 873 my @tip = (
853 "The current number of users logged in on the server.", 874 "The current number of users logged in on the server.",
854 "The hostname of the server.", 875 "The hostname of the server.",
… …
864 for 0 .. $#col; 885 for 0 .. $#col;
865 886
866 my @align = qw(1 0 1 1 -1); 887 my @align = qw(1 0 1 1 -1);
867 888
868 my $y = 0; 889 my $y = 0;
869 for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) { 890 for my $m (
891 sort {
892 $b->{version} <=> $a->{version}
893 or $b->{users} <=> $a->{users}
894 }
895 @{ $msg->{servers} }
896 ) {
870 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m; 897 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) =
898 @$m{qw(ip age hostname users version description ibytes obytes uptime)};
871 899
872 for ($desc) { 900 for ($desc) {
873 s/<br>/\n/gi; 901 s/<br>/\n/gi;
874 s/<li>/\n· /gi; 902 s/<li>/\n· /gi;
875 s/<.*?>//sgi; 903 s/<.*?>//sgi;
876 s/&/&amp;/g; 904 s/&amp;/&/g;
877 s/</&lt;/g; 905 s/&lt;/</g;
878 s/>/&gt;/g; 906 s/&gt;/>/g;
879 } 907 }
880 908
881 $uptime = sprintf "%dd %02d:%02d:%02d", 909 $uptime = sprintf "%dd %02d:%02d:%02d",
882 (int $m->[8] / 86400), 910 (int $uptime / 86400),
883 (int $m->[8] / 3600) % 24, 911 (int $uptime / 3600) % 24,
884 (int $m->[8] / 60) % 60, 912 (int $uptime / 60) % 60,
885 $m->[8] % 60; 913 $uptime % 60;
886 914
887 $m = [$users, $host, $uptime, $version, $desc]; 915 $m = [$users, $host, $uptime, $version, $desc];
888 916
889 $y++; 917 $y++;
890 918
… …
900 ), 928 ),
901 (new CFPlus::UI::Empty expand => 1), 929 (new CFPlus::UI::Empty expand => 1),
902 ]); 930 ]);
903 931
904 $table->add ($_, $y, new CFPlus::UI::Label 932 $table->add ($_, $y, new CFPlus::UI::Label
933 max_w => $::WIDTH * 0.4,
905 ellipsise => 0, 934 ellipsise => 0,
906 align => $align[$_], 935 align => $align[$_],
907 text => $m->[$_], 936 text => $m->[$_],
908 tooltip => $tip[$_], 937 tooltip => $tip[$_],
938 fg => ($m->[3] =~ /\+$/ ? [1, 1, 1] : [.7, .7, .7]),
909 can_hover => 1, 939 can_hover => 1,
910 can_events => 1, 940 can_events => 1,
911 fontsize => 0.8) 941 fontsize => 0.8)
912 for 0 .. $#$m; 942 for 0 .. $#$m;
913 } 943 }
944 } else {
945 $ok or $label->set_text ("error while contacting metaserver");
914 } 946 }
915 }); 947 };
948
916} 949}
917 950
918sub metaserver_dialog { 951sub metaserver_dialog {
919 my $vbox = new CFPlus::UI::VBox; 952 my $vbox = new CFPlus::UI::VBox;
920 my $table = new CFPlus::UI::Table; 953 my $table = new CFPlus::UI::Table;
… …
924 title => "Server List", 957 title => "Server List",
925 name => 'metaserver_dialog', 958 name => 'metaserver_dialog',
926 x => 'center', 959 x => 'center',
927 y => 'center', 960 y => 'center',
928 z => 3, 961 z => 3,
962 force_w => $::WIDTH * 0.9,
929 force_h => $::HEIGHT * 0.4, 963 force_h => $::HEIGHT * 0.7,
930 child => $vbox, 964 child => $vbox,
931 has_close_button => 1, 965 has_close_button => 1,
932 table => $table, 966 table => $table,
933 on_visibility_change => sub { 967 on_visibility_change => sub {
934 update_metaserver ($_[0]) if $_[1]; 968 update_metaserver ($_[0]) if $_[1];
… …
1054 $table->add (1, 13, my $saycmd = new CFPlus::UI::CheckBox 1088 $table->add (1, 13, my $saycmd = new CFPlus::UI::CheckBox
1055 state => $CFG->{show_tips}, 1089 state => $CFG->{show_tips},
1056 tooltip => "Show the <b>Tip of the day</b> window at startup?", 1090 tooltip => "Show the <b>Tip of the day</b> window at startup?",
1057 on_changed => sub { 1091 on_changed => sub {
1058 my ($self, $value) = @_; 1092 my ($self, $value) = @_;
1059 $CFG->{shop_tips} = $value; 1093 $CFG->{show_tips} = $value;
1060 0 1094 0
1061 } 1095 }
1062 ); 1096 );
1063 1097
1064 $vbox->add (new CFPlus::UI::FancyFrame 1098 $vbox->add (new CFPlus::UI::FancyFrame
… …
1268 #TODO# update to weigh/maxweight 1302 #TODO# update to weigh/maxweight
1269 $hb1->add ($STATWIDS->{i_weight} = new CFPlus::UI::Label align => -1); 1303 $hb1->add ($STATWIDS->{i_weight} = new CFPlus::UI::Label align => -1);
1270 1304
1271 $vb1->add (my $sw1 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1); 1305 $vb1->add (my $sw1 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);
1272 $sw1->add ($INV = new CFPlus::UI::Inventory); 1306 $sw1->add ($INV = new CFPlus::UI::Inventory);
1307 $INV->set_sort_order ($SORT_ORDER{$::CFG->{inv_sort}});
1273 1308
1274 $hb->add (my $vb2 = new CFPlus::UI::VBox); 1309 $hb->add (my $vb2 = new CFPlus::UI::VBox);
1275 1310
1276 $vb2->add ($INV_RIGHT_HB = new CFPlus::UI::HBox); 1311 $vb2->add ($INV_RIGHT_HB = new CFPlus::UI::HBox);
1277 1312
… …
1346 1381
1347 my $refresh; 1382 my $refresh;
1348 $refresh = $BIND_UPD_CB = sub { 1383 $refresh = $BIND_UPD_CB = sub {
1349 $binding_list->clear (); 1384 $binding_list->clear ();
1350 1385
1386 return unless $PROFILE;
1387
1351 for my $mod (keys %{$::CFG->{profile}{default}{bindings}}) { 1388 for my $mod (keys %{$PROFILE->{bindings}}) {
1352 for my $sym (keys %{$::CFG->{profile}{default}{bindings}{$mod}}) { 1389 for my $sym (keys %{$PROFILE->{bindings}{$mod}}) {
1353 my $cmds = $::CFG->{profile}{default}{bindings}{$mod}{$sym}; 1390 my $cmds = $PROFILE->{bindings}{$mod}{$sym};
1354 next unless ref $cmds eq 'ARRAY' and @$cmds > 0; 1391 next unless ref $cmds eq 'ARRAY' and @$cmds > 0;
1355 1392
1356 my $lbl = join "; ", @$cmds; 1393 my $lbl = join "; ", @$cmds;
1357 my $nam = CFPlus::BindingEditor::keycombo_to_name ($mod, $sym); 1394 my $nam = CFPlus::BindingEditor::keycombo_to_name ($mod, $sym);
1358 $binding_list->add (my $hb = new CFPlus::UI::HBox); 1395 $binding_list->add (my $hb = new CFPlus::UI::HBox);
1359 $hb->add (new CFPlus::UI::Button 1396 $hb->add (new CFPlus::UI::Button
1360 text => "delete", 1397 text => "delete",
1361 tooltip => "Deletes the binding", 1398 tooltip => "Deletes the binding",
1362 on_activate => sub { 1399 on_activate => sub {
1363 $binding_list->remove ($hb); 1400 $binding_list->remove ($hb);
1364 delete $::CFG->{profile}{default}{bindings}{$mod}{$sym}; 1401 delete $PROFILE->{bindings}{$mod}{$sym};
1365 0 1402 0
1366 }); 1403 });
1367 1404
1368 $hb->add (new CFPlus::UI::Button 1405 $hb->add (new CFPlus::UI::Button
1369 text => "edit", 1406 text => "edit",
1370 tooltip => "Edits the binding", 1407 tooltip => "Edits the binding",
1371 on_activate => sub { 1408 on_activate => sub {
1372 $::BIND_EDITOR->set_binding ( 1409 $::BIND_EDITOR->set_binding (
1373 $mod, $sym, $::CFG->{profile}{default}{bindings}{$mod}{$sym}, 1410 $mod, $sym, $PROFILE->{bindings}{$mod}{$sym},
1374 sub { 1411 sub {
1375 my ($nmod, $nsym, $ncmds) = @_; 1412 my ($nmod, $nsym, $ncmds) = @_;
1376 $::BIND_EDITOR->cfg_unbind ($mod, $sym); 1413 $::BIND_EDITOR->cfg_unbind ($mod, $sym);
1377 $::BIND_EDITOR->cfg_bind ($nmod, $nsym, $ncmds); 1414 $::BIND_EDITOR->cfg_bind ($nmod, $nsym, $ncmds);
1378 $refresh->(); 1415 $refresh->();
… …
2020 log_fontsize => 0.7, 2057 log_fontsize => 0.7,
2021 gauge_fontsize => 1, 2058 gauge_fontsize => 1,
2022 gauge_size => 0.35, 2059 gauge_size => 0.35,
2023 stat_fontsize => 0.7, 2060 stat_fontsize => 0.7,
2024 mapsize => 100, 2061 mapsize => 100,
2025 say_command => 'say', 2062 say_command => 'chat',
2026 audio_enable => 1, 2063 audio_enable => 1,
2027 bgm_enable => 1, 2064 bgm_enable => 1,
2028 bgm_volume => 0.25, 2065 bgm_volume => 0.25,
2029 face_prefetch => 0, 2066 face_prefetch => 0,
2030 output_sync => 1, 2067 output_sync => 1,
… …
2084# } 2121# }
2085# my $t2 = Time::HiRes::time; 2122# my $t2 = Time::HiRes::time;
2086# warn $t2-$t1; 2123# warn $t2-$t1;
2087# } 2124# }
2088 2125
2126 $startup_done->();
2127
2089 video_init; 2128 video_init;
2090 audio_init; 2129 audio_init;
2091} 2130}
2092 2131
2093show_tip_of_the_day if $CFG->{show_tips}; 2132show_tip_of_the_day if $CFG->{show_tips};

Diff Legend

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