--- deliantra/Deliantra-Client/bin/cfplus 2006/09/29 00:56:06 1.119
+++ deliantra/Deliantra-Client/bin/cfplus 2006/12/04 15:17:14 1.134
@@ -1,8 +1,31 @@
#!/opt/bin/perl
+my $startup_done = sub { };
+
+# do splash-screen thingy on win32
+BEGIN {
+ if (%PAR::LibCache && $^O eq "MSWin32") {
+ while (my ($filename, $zip) = each %PAR::LibCache) {
+ $zip->extractMember ("SPLASH.bmp", "$ENV{PAR_TEMP}/SPLASH.bmp");
+ }
+
+ require Win32::GUI::SplashScreen;
+
+ Win32::GUI::SplashScreen::Show (
+ -file => "$ENV{PAR_TEMP}/SPLASH.bmp",
+ );
+
+ $startup_done = sub {
+ Win32::GUI::SplashScreen::Done (1);
+ };
+ }
+}
+
use strict;
use utf8;
+use Carp 'verbose';
+
# do things only needed for single-binary version (par)
BEGIN {
if (%PAR::LibCache) {
@@ -10,7 +33,7 @@
while (my ($filename, $zip) = each %PAR::LibCache) {
for ($zip->memberNames) {
- next unless /^\/root\/(.*)/;
+ next unless /^root\/(.*)/;
$zip->extractMember ($_, "$ENV{PAR_TEMP}/$1")
unless -e "$ENV{PAR_TEMP}/$1";
}
@@ -47,24 +70,20 @@
$Event::Eval = 0;
$Event::DIED = sub {
- # TODO: display dialog box or so
- Carp::cluck $_[1];#d#TODO: remove when stable
- return;#d#
- CFPlus::fatal ($_[1]);
+ CFPlus::fatal Carp::longmess $_[1]
};
-our $VERSION = '0.9';
-
my $MAX_FPS = 60;
my $MIN_FPS = 5; # unused as of yet
-our $META_SERVER = "crossfire.real-time.com:13326";
+our $META_SERVER = "http://metaserver.schmorp.de/current.json";
our $LAST_REFRESH;
our $NOW;
our $CFG;
our $CONN;
+our $PROFILE; # current profile
our $FAST; # fast, low-quality mode, possibly useful for software-rendering
our $WANT_REFRESH;
@@ -105,6 +124,7 @@
our $STATS_PAGE;
our $SKILL_PAGE;
our $SPELL_PAGE;
+our $SPELL_LIST;
our $HELP_WINDOW;
our $MESSAGE_WINDOW;
@@ -132,6 +152,9 @@
our $PICKUP_CFG;
+our $IN_BUILD_MODE;
+our $BUILD_BUTTON;
+
sub status {
$STATUSBOX->add (CFPlus::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
}
@@ -140,6 +163,17 @@
$DEBUG_STATUS->set_text ($_[0]);
}
+sub message {
+ my ($para) = @_;
+
+ my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
+
+ $para->{markup} = "$time $para->{markup}";
+
+ $LOGVIEW->add_paragraph ($para);
+ $LOGVIEW->scroll_to_bottom;
+}
+
sub destroy_query_dialog {
(delete $_[0]{query_dialog})->destroy
if $_[0]{query_dialog};
@@ -346,22 +380,24 @@
$LOGIN_BUTTON->set_text ("Logout");
$SETUP_DIALOG->hide;
+ $PROFILE = $CFG->{profile}{default};
+
my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
- my ($host, $port) = split /:/, $CFG->{profile}{default}{host};
+ my ($host, $port) = split /:/, $PROFILE->{host};
- $MAP = new CFPlus::Map $mapsize, $mapsize;
+ $MAP = new CFPlus::Map;
$CONN = eval {
new CFPlus::Protocol
host => $host,
port => $port || 13327,
- user => $CFG->{profile}{default}{user},
- pass => $CFG->{profile}{default}{password},
+ user => $PROFILE->{user},
+ pass => $PROFILE->{password},
mapw => $mapsize,
maph => $mapsize,
- client => "cfplus $VERSION $] $^O",
+ client => "cfplus $CFPlus::VERSION $] $^O",
map_widget => $MAPWIDGET,
logview => $LOGVIEW,
@@ -398,7 +434,7 @@
$SETUP_NOTEBOOK->set_current_page ($SETUP_SERVER);
$SETUP_DIALOG->show;
$PL_WINDOW->hide;
- $SPELL_PAGE->clear_spells;
+ $SPELL_LIST->clear_spells;
return unless $CONN;
@@ -635,6 +671,7 @@
$table->add (1, 2, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 4; 0 });
$table->add (0, 3, new CFPlus::UI::Label text => "Suppress Tooltips");
$table->add (1, 3, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 8; 0 });
+ $table->add (0, 4, new CFPlus::UI::Button text => "die on click(tm)", on_activate => sub { die "violator" } );
my @default_smooth = (0.05, 0.13, 0.05, 0.13, 0.30, 0.13, 0.05, 0.13, 0.05);
@@ -826,27 +863,15 @@
$table->clear;
$table->add (0, 0, my $label = new CFPlus::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
- my $buf;
-
- my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;
-
- unless ($fh) {
- $label->set_text ("unable to contact metaserver: $!");
- return;
- }
-
- Event->io (fd => $fh, poll => 'r', cb => sub {
- my $res = sysread $fh, $buf, 8192, length $buf;
-
- if (!defined $res) {
- $_[0]->w->cancel;
- $label->set_text ("error while retrieving server list: $!");
- } elsif ($res == 0) {
- $_[0]->w->cancel;
- status "server list retrieved";
+ my $ok = 0;
- utf8::decode $buf if utf8::valid $buf;
+ CFPlus::background {
+ my $ua = CFPlus::lwp_useragent;
+ CFPlus::background_msg CFPlus::from_json +(CFPlus::lwp_check $ua->get ($META_SERVER))->decoded_content;
+ } sub {
+ my ($msg) = @_;
+ if ($msg) {
$table->clear;
my @tip = (
@@ -866,23 +891,30 @@
my @align = qw(1 0 1 1 -1);
my $y = 0;
- for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) {
- my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m;
+ for my $m (
+ sort {
+ $b->{version} <=> $a->{version}
+ or $b->{users} <=> $a->{users}
+ }
+ @{ $msg->{servers} }
+ ) {
+ my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) =
+ @$m{qw(ip age hostname users version description ibytes obytes uptime)};
for ($desc) {
s/
/\n/gi;
s/