--- deliantra/Deliantra-Client/DC/Main.pm 2011/12/27 07:23:33 1.1
+++ deliantra/Deliantra-Client/DC/Main.pm 2016/11/17 04:15:10 1.29
@@ -19,12 +19,15 @@
use common::sense;
use Carp 'verbose';
+use Cwd ();
+use Digest::MD5 ();
use EV;
BEGIN { *time = \&EV::time }
use List::Util qw(max min);
use Deliantra;
+use Deliantra::Util;
use Deliantra::Protocol::Constants;
use AnyEvent::Util ();
@@ -33,6 +36,7 @@
use Compress::LZF;
use JSON::XS;
+use Urlader;
use DC;
@@ -42,13 +46,22 @@
BEGIN {
$SIG{__DIE__} = sub {
- return if $^S;
+ return if $^S; # quick reject
+
+ # return if there are any eval contexts in the call stack
+ for my $i (0..999) {
+ my ($sub, $is_require) = (caller $i)[3, 7]
+ or last;
+ return if $sub eq "(eval)" && !$is_require;
+ }
+
crash "CRASH/DIE: $_[0]" => 1;
DC::fatal Carp::longmess "$_[0]";
}
}
use DC::OpenGL ();
+use DC::Audio ();
use DC::Protocol;
use DC::DB;
use DC::UI;
@@ -118,6 +131,7 @@
our $BUTTONBAR; # the menu buttons
our $METASERVER;
our $LOGIN_BUTTON;
+our $LOGIN_ERROR;
our $QUIT_DIALOG;
our $HOST_ENTRY;
our $FULLSCREEN_ENABLE;
@@ -135,6 +149,7 @@
our $MUSIC_PLAYING_WIDGET;
our $LICENSE_WIDGET;
+our $DOWNLOADS_WIDGET;
our $PICKUP_PAGE;
our $INVENTORY_PAGE;
@@ -187,7 +202,7 @@
$msg =~ s/\s+$//;
# backtrace as second step, in case it crashes, too
- crash Carp::longmess "$msg\nbacktrace, for client version $DC::VERSION, generated"
+ crash Carp::longmess "$msg\nbacktrace, for client version $DC::VERSION$Urlader::EXE_VER, generated"
if $backtrace;
};
@@ -199,7 +214,7 @@
return unless $CONN;
$CONN->send_exti_msg (clientlog => $msg);
- $CONN->send_exti_msg (clientlog => Carp::longmess "$msg\nbacktrace, for client version $DC::VERSION, generated") if $backtrace;
+ $CONN->send_exti_msg (clientlog => Carp::longmess "$msg\nbacktrace, for client version $DC::VERSION$Urlader::EXE_VER, generated") if $backtrace;
}
#############################################################################
@@ -242,6 +257,40 @@
$MODBOX->set_markup ("$markup");
}
+sub errorbox {
+ my ($msg) = @_;
+
+ status $msg;
+
+ my $dialog = new DC::UI::Toplevel
+ x => "center",
+ y => "center",
+ z => 200,
+ title => "Error",
+ child => my $vbox = new DC::UI::VBox,
+ has_close_button => 1,
+ on_delete => sub {
+ $_[0]->destroy;
+ },
+ ;
+
+ add $vbox new DC::UI::Label
+ align => 0.5,
+ ellipsise => 0,
+ text => $msg;
+
+ add $vbox new DC::UI::Button
+ expand => 1,
+ text => "OK",
+ on_activate => sub {
+ $dialog->destroy;
+ 0
+ }
+ ;
+
+ $dialog->show;
+}
+
#############################################################################
#TODO: maybe move into own audio module...
@@ -464,25 +513,9 @@
sub audio_init {
if ($CFG->{audio_enable}) {
- if (length $CFG->{audio_driver}) {
- local $ENV{SDL_AUDIODRIVER} = $CFG->{audio_driver};
- DC::SDL_Init DC::SDL_INIT_AUDIO
- and die "SDL::Init failed!\n";
- } else {
- DC::SDL_Init DC::SDL_INIT_AUDIO
- and die "SDL::Init failed!\n";
- }
-
- $ENV{MIX_EFFECTSMAXSPEED} = 1;
- $SDL_MIXER = !DC::Mix_OpenAudio
- $CFG->{audio_hw_frequency},
- DC::MIX_DEFAULT_FORMAT,
- $CFG->{audio_hw_channels},
- $CFG->{audio_hw_chunksize};
+ DC::Audio::init;
if ($SDL_MIXER) {
- DC::Mix_AllocateChannels $CFG->{audio_mix_channels};
-
audio_music_finished;
} else {
status "Unable to open sound device: there will be no sound";
@@ -517,6 +550,189 @@
}
#############################################################################
+# Over-the-air updates
+
+sub ota_update {
+ my ($face, $size, $md5) = @_;
+
+ my $coro = Coro::async_pool {
+ my $override = "$Urlader::EXE_DIR/override";
+
+ $MESSAGE_DIST->add_channel ({
+ id => "ota_update",
+ title => "Update",
+ tooltip => "Software Update Log",
+ });
+
+ $MESSAGE_DIST->message ({ type => "ota_update", markup => "preparing override..." });
+
+ my $fh = Coro::AIO::aio_open "$override.tmp", IO::AIO::O_WRONLY | IO::AIO::O_CREAT | IO::AIO::O_TRUNC, 0777;
+
+ unless ($fh) {
+ $MESSAGE_DIST->message ({ type => "ota_update", markup => (DC::asxml "unable to write software update:\n$Urlader::EXE_DIR/override.tmp:\n$!") });
+ return;
+ }
+
+ $MESSAGE_DIST->message ({ type => "ota_update", markup => "downloading $size bytes..." });
+
+ my $cv = AE::cv;
+ my $error;
+
+ $cv->begin (Coro::rouse_cb);
+ $CONN->ask_face (
+ $face,
+ -1000,
+ sub {
+ $STATUSBOX->add (
+ (sprintf "update download: %d/%d", $size - $_[1], $size),
+ pri => -9, group => "ota_update", timeout => 60, fg => [1, 1, 0, 1]
+ );
+
+ $cv->begin;
+ my $len = length $_[2];
+ IO::AIO::aio_write $fh, $_[1], $len, $_[2], undef, sub {
+ $error ||= $_[0] != $len;
+ $cv->end;
+ };
+ },
+ sub {
+ $cv->end;
+ },
+ );
+
+ Coro::rouse_wait;
+
+ $STATUSBOX->clr_group ("ota_update");
+
+ $error ||= Coro::AIO::aio_fsync $fh;
+ $error ||= Coro::AIO::aio_close $fh;
+
+ if ($error) {
+ $MESSAGE_DIST->message ({ type => "ota_update", markup => "file write error, update aborted." });
+ Coro::AIO::aio_unlink "$override.tmp";
+ return;
+ }
+
+ {
+ $MESSAGE_DIST->message ({ type => "ota_update", markup => "verifying update file..." });
+
+ my $fh = Coro::AIO::aio_open "$override.tmp", IO::AIO::O_RDONLY, 0;
+
+ if ($fh) {
+ $error ||= Coro::AIO::aio_stat "$override.tmp";
+ $error ||= -s _ != $size;
+ Coro::AIO::aio_readahead $fh, 0, $size;
+
+ my $f_md5 = new Digest::MD5;
+ binmode $fh; # ugh :(
+ $f_md5->addfile ($fh);
+ $f_md5 = $f_md5->hexdigest;
+ $error ||= $md5 ne $f_md5;
+ }
+ }
+
+ if ($error) {
+ $MESSAGE_DIST->message ({ type => "ota_update", markup => "verification failed, update aborted." });
+ Coro::AIO::aio_unlink "$override.tmp";
+ return;
+ }
+
+ $MESSAGE_DIST->message ({ type => "ota_update", markup => "replacing override file..." });
+
+ if (Coro::AIO::aio_rename "$override.tmp", $override) {
+ $MESSAGE_DIST->message ({ type => "ota_update", markup => "unable to replace override file, update aborted." });
+ Coro::AIO::aio_unlink "$override.tmp";
+ }
+
+ $MESSAGE_DIST->message ({ type => "ota_update", markup => "success - update becomes active after restarting." });
+ };
+
+ $CONN->{ota_update} = Guard::guard {
+ $coro->cancel;
+ };
+}
+
+sub ota_update_ask {
+ my ($ok, $face, $ver, $size, $md5, $changes) = @_;
+
+ $CONN->{w}{ota_dialog} = my $dialog = new DC::UI::Toplevel
+ x => "center",
+ y => "center",
+ z => 55,
+ force_w => $::WIDTH * 0.7,
+ force_h => $::HEIGHT * 0.7,
+ title => "Software update available",
+ child => my $vbox = new DC::UI::VBox,
+ ;
+
+ $vbox->add (new DC::UI::Label
+ ellipsise => 0,
+ text => "The server offers a software update, "
+ . "do you want to start downloading this update in the background?",
+ );
+
+ $vbox->add (new DC::UI::FancyFrame
+ expand => 1,
+ label => "Details",
+ child => (new DC::UI::TextScroller
+ expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4,
+ par => [{
+ markup => "Old revision: $Urlader::EXE_VER\n"
+ . "New revision: $ver\n"
+ . "Download size: $size bytes\n\n"
+ . "Changes:\n\n"
+ . DC::asxml $changes
+ }],
+ ),
+ );
+
+ $vbox->add (my $hbox = new DC::UI::HBox);
+
+ $hbox->add (new DC::UI::Button
+ expand => 1,
+ text => "Not now",
+ on_activate => sub {
+ $dialog->destroy;
+ 0
+ }
+ );
+ $hbox->add (new DC::UI::Button
+ expand => 1,
+ text => "Yes, start downloading",
+ on_activate => sub {
+ $dialog->destroy;
+ ota_update $face, $size, $md5;
+ 0
+ },
+ );
+
+ $dialog->show;
+}
+
+sub ota_update_check {
+ return unless defined $Urlader::EXE_ID;
+
+ ::message { markup => "Checking for software update..." };
+
+ $CONN->send_exti_req (ota_update => $Urlader::URLADER_VERSION, $Urlader::EXE_ID, $Urlader::EXE_VER, sub {
+ my ($ok, $face, $ver, $size, $md5, $changes) = @_;
+
+ if ($ok) {
+ if (defined $ver) {
+ ::message { markup => "Server offers version $ver (we are version $Urlader::EXE_VER)." };
+ &ota_update_ask;
+ } else {
+ ::message { markup => "Server has no newer version." };
+ }
+ } else {
+ ::message { markup => "Server does not support software update." };
+ }
+
+ ()
+ });
+}
+
+#############################################################################
sub destroy_query_dialog {
(delete $_[0]{query_dialog})->destroy
@@ -750,23 +966,24 @@
}
sub dc_connect {
- my ($host, $port) = @_;
+ my ($host, $port, $create) = @_;
my $mapw = List::Util::min 48, List::Util::max 11, int 1.5 + $WIDTH * $CFG->{mapsize} * 0.01 / 32;
my $maph = List::Util::min 48, List::Util::max 11, int 1.5 + $HEIGHT * $CFG->{mapsize} * 0.01 / 32;
- $CONN =
+ $CONN =
new DC::Protocol
host => $host,
port => $port,
+ create_login => $create,
user => $PROFILE->{user},
- pass => $PROFILE->{password},
+ pass => (pack "H*", $PROFILE->{password}),
mapw => $mapw,
maph => $maph,
c_version => {
client => "deliantra",
- clientver => $DC::VERSION,
+ clientver => "$DC::VERSION$Urlader::EXE_VER",
gl_vendor => DC::OpenGL::gl_vendor,
gl_version => DC::OpenGL::gl_version,
},
@@ -785,17 +1002,29 @@
if ($_[0]) {
DC::lowdelay fileno $CONN->{fh};
+ ota_update_check;
+
status "successfully connected to the server";
} else {
undef $CONN;
- status "unable to connect: $!";
+ $LOGIN_ERROR->{fg} = [1, 0, 0];
+ $LOGIN_ERROR->set_text ("Unable to connect to server: $!");
stop_game();
}
},
+
+ on_addme => sub {
+ my ($ok, $msg) = @_;
+
+ $LOGIN_ERROR->{fg} = $ok ? [0, 1, 0] : [1, 0, 0];
+ $LOGIN_ERROR->set_text ($msg);
+ },
;
}
-sub start_game {
+sub start_game($) {
+ my ($create) = @_;
+
status "logging in...";
my $server = $PROFILE->{host} || $DEFAULT_SERVER;
@@ -820,10 +1049,10 @@
}
}
- dc_connect $host, $port;
+ dc_connect $host, $port, $create;
};
} else {
- dc_connect $host, $port;
+ dc_connect $host, $port, $create;
}
}
@@ -951,7 +1180,7 @@
state => $CFG->{texture_compression},
tooltip => "Use texture compression. Normally this will not reduce visual quality noticable but "
. "will save a lot of memory and increase performance (and also fall prey to the ever-buggy Mac OS X software renderer). "
- . "The compression algorithm can differ form card to card, so your mileage may vary. This setting is ignored in "
+ . "The compression algorithm can differ from card to card, so your mileage may vary. This setting is ignored in "
. "forced OpenGL 1.1 mode and when using the Apple renderer.",
on_changed => sub { my ($self, $value) = @_; $CFG->{texture_compression} = $value; 0 }
);
@@ -1133,7 +1362,7 @@
tooltip => "You can override the audio driver to use here. Leaving it empty will result "
. "in Deliantra picking one automatically. GNU/Linux users often prefer specific "
. "drivers though, and can experiment with alsa, dsp, esd, pulse, arts, nas "
- . "or other system-specific drivers. Selecting the wrong driver here will simply result"
+ . "or other system-specific drivers. Selecting the wrong driver here will simply result "
. "in no sound.",
on_changed => sub { my ($self, $value) = @_; $CFG->{audio_driver} = $value; 1 }
);
@@ -1666,41 +1895,81 @@
child => (my $table = new DC::UI::Table expand => 1, col_expand => [0, 1]),
);
- $table->add_at (0, 4, new DC::UI::Label align => 1, text => "Username");
- $table->add_at (1, 4, new DC::UI::Entry
+ my $nullpw = "\x00" x 16;
+
+ $table->add_at (0, 0, new DC::UI::Label align => 1, text => "Username");
+ $table->add_at (1, 0, new DC::UI::Entry
text => $PROFILE->{user},
tooltip => "The name of your character on the server. The name is case-sensitive!",
on_changed => sub { my ($self, $value) = @_; $PROFILE->{user} = $value; 1 }
);
- $table->add_at (0, 5, new DC::UI::Label align => 1, text => "Password");
- $table->add_at (1, 5, new DC::UI::Entry
- text => $PROFILE->{password},
+ $table->add_at (0, 1, new DC::UI::Label align => 1, text => "Password");
+ $table->add_at (1, 1, my $pw1 = new DC::UI::Entry
+ text => $PROFILE->{password} ? $nullpw : "",
hidden => 1,
tooltip => "The password for your character.",
- on_changed => sub { my ($self, $value) = @_; $PROFILE->{password} = $value; 1 }
+ on_focus_in => sub {
+ my ($self) = @_;
+ $self->set_text ("")
+ if $self->{text} eq $nullpw;
+ 0
+ },
+ on_changed => sub {
+ my ($self, $value) = @_;
+ $PROFILE->{password} = unpack "H*", Deliantra::Util::hash_pw $value
+ if length $value && $value ne $nullpw;
+ 1
+ },
);
- $table->add_at (1, 11, $LOGIN_BUTTON = new DC::UI::Button
+ $table->add_at (1, 2, $LOGIN_BUTTON = new DC::UI::Button
expand => 1,
- text => "Login / Register",
- tooltip => "This button will either login to the account configured above or register a new account.",
+ text => "Login to Existing Account",
+ tooltip => "This button will login to the account given by the Username and Password fields above.",
on_activate => sub {
$CONN ? stop_game
- : start_game;
+ : start_game 0;
+ 1
+ },
+ );
+
+ $table->add_at (0, 3, new DC::UI::Label align => 1, text => "Password");
+ $table->add_at (1, 3, my $pw2 = new DC::UI::Entry
+ hidden => 1,
+ tooltip => "The new password for your character",
+ );
+
+ $table->add_at (1, 4, new DC::UI::Button
+ expand => 1,
+ text => "Create New Account",
+ tooltip => "This button will try to create a new account - you need to fill out the Username and the two Password fields above, using the same password for both Password fields.",
+ on_activate => sub {
+ if ($pw1->{text} ne $pw2->{text}) {
+ $LOGIN_ERROR->{fg} = [1, 0, 0];
+ $LOGIN_ERROR->set_text ("The passwords do not match - try to enter them again.");
+ } else {
+ $CONN or start_game 1;
+ }
1
},
);
$vbox->add (new DC::UI::FancyFrame
+ label => "Server Message",
+ tooltip => "The last message, or error, from the server.",
+ child => ($LOGIN_ERROR = new DC::UI::Label valign => 0, ellipsise => 0),
+ );
+
+ $vbox->add (new DC::UI::FancyFrame
label => "How to Play",
- min_h => 240,
+ min_h => 240,#d# should not be necessary - widget bug
child => (new DC::UI::Label valign => 0, ellipsise => 0,
markup =>
"First select a suitable video resolution in the Graphics tab, above.\n\n"
- . "Then register a new account (or use an existing one if you have one). "
- . "To register an account, choose a username that hasn't been taken yet (just guess) and "
- . "try to log-in. Follow the instructions in the Log tab in the message window.",
+ . "Then create a new account (or use an existing one if you have one).\n\n"
+ . "To create an account, choose a username that hasn't been taken yet (just guess) and "
+ . "fill out the top two Password fields using the same password, then press Create New Account.",
),
);
@@ -1775,59 +2044,83 @@
}
sub client_setup {
- my $table = new DC::UI::Table expand => 1, col_expand => [0, 1];
+ my $vbox = new DC::UI::VBox;
- my $row = 0;
+ $vbox->add (my $top = new DC::UI::FancyFrame expand => 1, label => "Client Settings");
+ $vbox->add (my $bot = new DC::UI::FancyFrame expand => 1, label => "Client Info");
- $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Tip of the day");
- $table->add_at (1, $row++, new DC::UI::CheckBox
- c_colspan => 2,
- state => $CFG->{show_tips},
- tooltip => "Show the Tip of the day window at startup?",
- on_changed => sub {
- my ($self, $value) = @_;
- $CFG->{show_tips} = $value;
- 0
- }
- );
+ {
+ $top->add (my $table = new DC::UI::Table expand => 1, col_expand => [0, 1]);
- $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Message Window Size");
- $table->add_at (1, $row++, my $saycmd = new DC::UI::Entry
- c_colspan => 2,
- text => $CFG->{logview_max_par},
- tooltip => "This is maximum number of messages remembered in the Message window. If the server "
- . "sends more messages than this number, older messages get removed to save memory and "
- . "computing time. A value of 0 disables this feature, but that is not recommended.",
- on_changed => sub {
- my ($self, $value) = @_;
- $MESSAGE_DIST->set_max_par ($CFG->{logview_max_par} = $value*1);
- 0
- },
- );
+ my $row = 0;
- $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Config Autosave");
- $table->add_at (1, $row, new DC::UI::CheckBox
- state => $CFG->{config_autosave},
- tooltip => "Normally, configuration settings and the user interface layout "
- . "are saved on client exit. You can disable this behaviour by "
- . "unchecking this checkbox.",
- on_changed => sub {
- my ($self, $value) = @_;
- $CFG->{config_autosave} = $value;
- 0
- }
- );
- $table->add_at (2, $row++, new DC::UI::Button
- text => "Save Now",
- tooltip => "Use this to manually save configuration and UI layout when "
- . "autosave is disabled.",
- on_activate => sub {
- DC::write_cfg;
- 0
- }
- );
+ $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Tip of the day");
+ $table->add_at (1, $row++, new DC::UI::CheckBox
+ c_colspan => 2,
+ state => $CFG->{show_tips},
+ tooltip => "Show the Tip of the day window at startup?",
+ on_changed => sub {
+ my ($self, $value) = @_;
+ $CFG->{show_tips} = $value;
+ 0
+ }
+ );
- $table
+ $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Message Window Size");
+ $table->add_at (1, $row++, my $saycmd = new DC::UI::Entry
+ c_colspan => 2,
+ text => $CFG->{logview_max_par},
+ tooltip => "This is maximum number of messages remembered in the Message window. If the server "
+ . "sends more messages than this number, older messages get removed to save memory and "
+ . "computing time. A value of 0 disables this feature, but that is not recommended.",
+ on_changed => sub {
+ my ($self, $value) = @_;
+ $MESSAGE_DIST->set_max_par ($CFG->{logview_max_par} = $value*1);
+ 0
+ },
+ );
+
+ $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Config Autosave");
+ $table->add_at (1, $row, new DC::UI::CheckBox
+ state => $CFG->{config_autosave},
+ tooltip => "Normally, configuration settings and the user interface layout "
+ . "are saved on client exit. You can disable this behaviour by "
+ . "unchecking this checkbox.",
+ on_changed => sub {
+ my ($self, $value) = @_;
+ $CFG->{config_autosave} = $value;
+ 0
+ }
+ );
+ $table->add_at (2, $row++, new DC::UI::Button
+ text => "Save Now",
+ tooltip => "Use this to manually save configuration and UI layout when "
+ . "autosave is disabled.",
+ on_activate => sub {
+ DC::save_cfg;
+ 0
+ }
+ );
+ }
+
+ {
+ $bot->add (my $table = new DC::UI::Table expand => 1, col_expand => [0, 1]);
+
+ my $row = 0;
+
+ $table->add_at (0, $row , new DC::UI::Label align => 1, text => "Data Directory");
+ $table->add_at (1, $row++, new DC::UI::Label align => 0, text => $Deliantra::VARDIR, tooltip => "");
+ $table->add_at (0, $row , new DC::UI::Label align => 1, text => "Database Directory");
+ $table->add_at (1, $row++, new DC::UI::Label align => 0, text => $DC::DB::DBDIR, tooltip => "");
+ $table->add_at (0, $row , new DC::UI::Label align => 1, text => "Urlader (Prebuilt)");
+ $table->add_at (1, $row++, new DC::UI::Label align => 0, text => $ENV{URLADER_VERSION}, tooltip => "");
+ $table->add_at (0, $row , new DC::UI::Label align => 1, text => "Branch (Prebuilt)");
+ $table->add_at (1, $row++, new DC::UI::Label align => 0, text => $ENV{URLADER_EXE_ID}, tooltip => "");
+ $table->add_at (0, $row , new DC::UI::Label align => 1, text => "Revision (Prebuilt)");
+ $table->add_at (1, $row++, new DC::UI::Label align => 0, text => $ENV{URLADER_EXE_VER}, tooltip => "");
+ }
+
+ $vbox
}
sub autopickup_setup {
@@ -2008,16 +2301,51 @@
my $vb = new DC::UI::VBox;
$vb->add (new DC::UI::FancyFrame
- label => "Currently playing music",
+ label => "Current background music",
child => new DC::UI::ScrolledWindow scroll_x => 1, scroll_y => 0,
child => ($MUSIC_PLAYING_WIDGET = new DC::UI::Label ellipsise => 0, fontsize => 0.8),
);
$vb->add (new DC::UI::FancyFrame
+ label => "Current downloads",
+ child => ($DOWNLOADS_WIDGET = new DC::UI::Table
+ expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4),
+ );
+
+ $DOWNLOADS_WIDGET->connect (visibility_change => sub {
+ my ($self) = @_;
+
+ delete $self->{updater};
+ return unless $_[1];
+
+ $self->{updater} = AE::timer 0, 0.7, sub {
+ $self->clear;
+
+ return unless $CONN;
+
+ my @nums = sort { $b <=> $a } keys %{ $CONN->{ix_recv_buf} };
+ return unless @nums;
+
+ $self->add_at (0, 0, new DC::UI::Label align => 1, text => "Face");
+ $self->add_at (1, 0, new DC::UI::Label align => 0, text => "Octets/Total");
+
+ for my $row (0 .. $#nums) {
+ my $num = $nums[$row];
+
+ my $total = length $CONN->{ix_recv_buf}{$num};
+ my $got = $total - $CONN->{ix_recv_ofs}{$num};
+
+ $self->add_at (0, $row + 1, new DC::UI::Label align => 1, text => $num, tooltip => "");
+ $self->add_at (1, $row + 1, new DC::UI::Label align => 0, text => "$got/$total", tooltip => "");
+ }
+ };
+ });
+
+ $vb->add (new DC::UI::FancyFrame
label => "Other media used in this session",
expand => 1,
child => ($LICENSE_WIDGET = new DC::UI::TextScroller
- expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4),
+ expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4),
);
$vb
@@ -2212,7 +2540,7 @@
$QUIT_DIALOG = new DC::UI::Toplevel
x => "center",
y => "center",
- z => 50,
+ z => 60,
title => "Really Quit?",
on_key_down => sub {
my ($dialog, $ev) = @_;
@@ -2269,8 +2597,8 @@
$MENUPOPUP = DC::UI::Menu->new (items => [
["Setup…\tF9" , sub { $SETUP_DIALOG->toggle_visibility }],
["Playerbook…\tTab" , sub { $PL_WINDOW ->toggle_visibility }],
- ["…Statistics\tF2" , sub { toggle_player_page ($::STATS_PAGE) }],
- ["…Skills\tF3" , sub { toggle_player_page ($::SKILL_PAGE) }],
+ ["…Statistics\tF2" , sub { toggle_player_page ($::STATS_PAGE) }],
+ ["…Skills\tF3" , sub { toggle_player_page ($::SKILL_PAGE) }],
["…Spells\tF4" , sub { toggle_player_page ($::SPELL_PAGE) }],
["…Inventory\tF5" , sub { toggle_player_page ($::INVENTORY_PAGE) }],
["Help Browser…\tF1" , sub { $HELP_WINDOW ->toggle_visibility }],
@@ -2278,7 +2606,7 @@
if ($CONN) {
open_quit_dialog;
} else {
- EV::unloop EV::UNLOOP_ALL;
+ EV::break EV::BREAK_ALL;
}
}],
]);
@@ -2415,7 +2743,7 @@
DC::SDL_InitSubSystem DC::SDL_INIT_VIDEO if $SDL_REINIT;
$SDL_REINIT = 0;
- @SDL_MODES = DC::SDL_ListModes 8, $CFG->{disable_alpha} ? 0 : 8;
+ @SDL_MODES = DC::SDL_ListModes 8, $CFG->{disable_alpha} ? 0 : 2;
@SDL_MODES = DC::SDL_ListModes 8, 8 unless @SDL_MODES;
@SDL_MODES = DC::SDL_ListModes 5, 0 unless @SDL_MODES;
@SDL_MODES or DC::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
@@ -2439,6 +2767,8 @@
$FULLSCREEN = $CFG->{fullscreen};
$FAST = $CFG->{fast};
+ DC::SDL_WM_SetCaption "Deliantra MORPG Client $DC::VERSION$Urlader::EXE_VER", "Deliantra"; # must be after SDL_Init
+
# due to mac os x braindamage, we simply retry with !fullscreen in case of an error
DC::SDL_SetVideoMode $WIDTH, $HEIGHT, $rgb, $alpha, $FULLSCREEN
or DC::SDL_SetVideoMode $WIDTH, $HEIGHT, $rgb, $alpha, !$FULLSCREEN
@@ -2634,7 +2964,7 @@
$NOW = EV::now;
($SDL_CB[$_->{type}] || sub { warn "unhandled event $_->{type}" })->($_)
- for DC::poll_events;
+ for DC::peep_events;
if (%animate_object) {
$_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
@@ -2657,7 +2987,7 @@
$SDL_CB[DC::SDL_QUIT] = sub {
crash "SDL_QUIT";
- EV::unloop EV::UNLOOP_ALL;
+ EV::break EV::BREAK_ALL;
};
$SDL_CB[DC::SDL_VIDEORESIZE] = sub { };
$SDL_CB[DC::SDL_VIDEOEXPOSE] = sub {
@@ -2700,147 +3030,102 @@
#############################################################################
$SIG{INT} = $SIG{TERM} = sub {
- EV::unloop;
+ EV::break;
#d# TODO calling exit here hangs the process in some futex
};
# due to mac os x + sdl combined braindamage, we need this contortion
-sub DC::Main::main {
- {
- DC::Pod::load_docwiki DC::find_rcfile "docwiki.pst";
+sub DC::Main::run {
+ DC::SDL_main_hack {
+ {
+ DC::Pod::load_docwiki DC::find_rcfile "docwiki.pst";
- if (-e "$Deliantra::VARDIR/client.cf") {
- DC::read_cfg "$Deliantra::VARDIR/client.cf";
- } else {
- #TODO: compatibility cruft
- DC::read_cfg "$Deliantra::OLDDIR/cfplusrc";
- print STDERR "INFO: used old configuration file\n";
- }
-
- DC::DB::Server::run;
-
- if ($CFG->{db_schema} < 1) {
- warn "INFO: upgrading database schema from 0 to 1, mapcache and tilecache will be lost\n";
- DC::DB::nuke_db;
- $CFG->{db_schema} = 1;
- DC::write_cfg;
- }
-
- DC::DB::open_db;
-
- DC::UI::set_layout ($::CFG->{layout});
-
- my %DEF_CFG = (
- config_autosave => 1,
- sdl_mode => undef,
- fullscreen => 1,
- fast => 0,
- force_opengl11 => undef,
- disable_alpha => 0,
- smooth_movement => 1,
- smooth_transitions => 1,
- texture_compression => 1,
- map_scale => 1,
- fow_enable => 1,
- fow_intensity => 0,
- fow_texture => 0,
- map_smoothing => 1,
- gui_fontsize => 1,
- log_fontsize => 0.7,
- gauge_fontsize => 1,
- gauge_size => 0.35,
- stat_fontsize => 0.7,
- mapsize => 100,
- audio_enable => 1,
- audio_hw_channels => 0,
- audio_hw_frequency => 0,
- audio_hw_chunksize => 0,
- audio_mix_channels => 8,
- effects_enable => 1,
- effects_volume => 1,
- bgm_enable => 1,
- bgm_volume => 0.5,
- output_rate => "",
- pickup => PICKUP_SPELLBOOK | PICKUP_SKILLSCROLL | PICKUP_VALUABLES,
- inv_sort => "mtime",
- default => "profile", # default profile
- show_tips => 1,
- logview_max_par => 1000,
- shift_fire_stop => 0,
- uitheme => "wood",
- map_shift_x => -24, # arbitrary
- map_shift_y => +24, # arbitrary
- );
-
- while (my ($k, $v) = each %DEF_CFG) {
- $CFG->{$k} = $v unless exists $CFG->{$k};
- }
-
- my @args = @ARGV;
-
- # OS X passes some process serial number of other shit. they
- # could have used an env var or any other sane mechanism. but
- # would it be os x then? no...
- shift @args if $args[0] =~ /^-psn_/;
-
- my $profile = 'default';
-
- for (my $i = 0; $i < @args; $i++) {
- if ($args[$i] =~ /^--?profile$/) {
- $profile = $args[$i + 1];
- splice @args, $i, 2, ();
- $i = 0;
- } elsif ($args[$i] =~ /^--?h/) {
- print STDERR "Usage: $0 [--profile name] [host [user [password]]]\n";
- exit 0;
- }
- }
-
- $CFG->{profile}{$profile} ||= {};
- $PROFILE = $CFG->{profile}{$profile};
- $PROFILE->{host} ||= "gameserver.deliantra.net";
-
- $PROFILE->{host} = $args[0] if @args > 0;
- $PROFILE->{user} = $args[1] if @args > 1;
- $PROFILE->{password} = $args[2] if @args > 2;
-
- # convert old bindings (only default profile matters)
- if (my $bindings = delete $PROFILE->{bindings}) {
- while (my ($mod, $syms) = each %$bindings) {
- while (my ($sym, $cmds) = each %$syms) {
- push @{ $PROFILE->{macro} }, {
- accelkey => [$mod*1, $sym*1],
- action => $cmds,
- };
+ DC::load_cfg;
+ DC::upgrade_cfg;
+
+ DC::Audio::probe;
+
+ DC::DB::Server::run;
+
+ if ($CFG->{db_schema} < 1) {
+ warn "INFO: upgrading database schema from 0 to 1, mapcache and tilecache will be lost\n";
+ DC::DB::nuke_db;
+ $CFG->{db_schema} = 1;
+ DC::save_cfg;
+ }
+
+ DC::DB::open_db;
+
+ DC::UI::set_layout ($::CFG->{layout});
+
+ my @args = @ARGV;
+
+ # OS X passes some process serial number of other shit. they
+ # could have used an env var or any other sane mechanism. but
+ # would it be os x then? no...
+ shift @args if $args[0] =~ /^-psn_/;
+
+ my $profile = 'default';
+
+ for (my $i = 0; $i < @args; $i++) {
+ if ($args[$i] =~ /^--?profile$/) {
+ $profile = $args[$i + 1];
+ splice @args, $i, 2, ();
+ $i = 0;
+ } elsif ($args[$i] =~ /^--?h/) {
+ print STDERR "Usage: $0 [--profile name] [host [user [password]]]\n";
+ exit 0;
}
}
- }
- $ENV{FONTCONFIG_FILE} = DC::find_rcfile "fonts/fonts.conf";
- $ENV{FONTCONFIG_DIR} = DC::find_rcfile "fonts";
+ $CFG->{profile}{$profile} ||= {};
+ $PROFILE = $CFG->{profile}{$profile};
+ $PROFILE->{host} ||= "gameserver.deliantra.net";
+
+ $PROFILE->{host} = $args[0] if @args > 0;
+ $PROFILE->{user} = $args[1] if @args > 1;
+ $PROFILE->{password} = unpack "H*", Deliantra::Util::hash_pw $args[2] if @args > 2;
+
+ # convert old bindings (only default profile matters)
+ if (my $bindings = delete $PROFILE->{bindings}) {
+ while (my ($mod, $syms) = each %$bindings) {
+ while (my ($sym, $cmds) = each %$syms) {
+ push @{ $PROFILE->{macro} }, {
+ accelkey => [$mod*1, $sym*1],
+ action => $cmds,
+ };
+ }
+ }
+ }
- {
- my @fonts = map DC::find_rcfile "fonts/$_", qw(
- DejaVuSans.ttf
- DejaVuSansMono.ttf
- DejaVuSans-Bold.ttf
- DejaVuSansMono-Bold.ttf
- DejaVuSans-Oblique.ttf
- DejaVuSansMono-Oblique.ttf
- DejaVuSans-BoldOblique.ttf
- DejaVuSansMono-BoldOblique.ttf
- mona.ttf
- );
+ # fontconfig doesn't support relative paths anymore, so use abs_path and keep fingers crossed
+ # these are ignored under windows, for some reason, and thus set in the loader
+ $ENV{FONTCONFIG_FILE} = "fonts.conf";
+ $ENV{FONTCONFIG_PATH} = Cwd::abs_path DC::find_rcfile "fonts";
+ $ENV{FONTCONFIG_DIR} = $ENV{FONTCONFIG_PATH}; # helps with older versions
+
+ {
+ my @fonts = map DC::find_rcfile "fonts/$_", qw(
+ DejaVuSans.ttf
+ DejaVuSansMono.ttf
+ DejaVuSans-Bold.ttf
+ DejaVuSansMono-Bold.ttf
+ DejaVuSans-Oblique.ttf
+ DejaVuSansMono-Oblique.ttf
+ DejaVuSans-BoldOblique.ttf
+ DejaVuSansMono-BoldOblique.ttf
+ mona.ttf
+ );
- DC::add_font $_ for @fonts;
+ DC::add_font $_ for @fonts;
- $FONT_PROP = new_from_file DC::Font $fonts[0];
- $FONT_FIXED = new_from_file DC::Font $fonts[1];
+ $FONT_PROP = new_from_file DC::Font $fonts[0];
+ $FONT_FIXED = new_from_file DC::Font $fonts[1];
- $FONT_PROP->make_default;
+ $FONT_PROP->make_default;
- DC::pango_init;
- }
+ DC::pango_init;
+ }
# compare mono (ft) vs. rgba (cairo)
# ft - 1.8s, cairo 3s, even in alpha-only mode
@@ -2855,33 +3140,34 @@
# warn $t2-$t1;
# }
+ }
+
+ DC::SDL_Init 0;
DC::IMG_Init; video_init;
DC::Mix_Init; audio_init;
- }
- show_tip_of_the_day if $CFG->{show_tips};
+ show_tip_of_the_day if $CFG->{show_tips};
- my $STARTUP_CANCEL; $STARTUP_CANCEL = EV::idle sub {
- undef $STARTUP_CANCEL;
- (pop @::STARTUP_DONE)->()
- while @::STARTUP_DONE;
- };
+ my $STARTUP_CANCEL; $STARTUP_CANCEL = EV::idle sub {
+ undef $STARTUP_CANCEL;
+ (pop @::STARTUP_DONE)->()
+ while @::STARTUP_DONE;
+ };
- debug_toggle 0;
+ debug_toggle 0;
- delete $SIG{__DIE__};
- EV::loop;
+ delete $SIG{__DIE__};
+ EV::run;
- DC::write_cfg if $CFG->{config_autosave};
+ DC::save_cfg if $CFG->{config_autosave};
- #video_shutdown;
- #audio_shutdown;
+ #video_shutdown;
+ #audio_shutdown;
- DC::OpenGL::quit;
- DC::SDL_Quit;
- DC::DB::Server::stop;
+ DC::OpenGL::quit;
+ DC::SDL_Quit;
+ DC::DB::Server::stop;
+ };
}
-*DC::Main::run = \&DC::SDL_braino; # see sub above
-
1