--- deliantra/Deliantra-Client/DC/Main.pm 2012/01/18 00:51:23 1.15 +++ deliantra/Deliantra-Client/DC/Main.pm 2012/11/17 10:40:09 1.24 @@ -27,6 +27,7 @@ use List::Util qw(max min); use Deliantra; +use Deliantra::Util; use Deliantra::Protocol::Constants; use AnyEvent::Util (); @@ -35,6 +36,7 @@ use Compress::LZF; use JSON::XS; +use Urlader; use DC; @@ -46,7 +48,7 @@ $SIG{__DIE__} = sub { return if $^S; # quick reject - # return if there are any eval contexts in the csall stack + # 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; @@ -59,7 +61,7 @@ } use DC::OpenGL (); -use DC::Audio; +use DC::Audio (); use DC::Protocol; use DC::DB; use DC::UI; @@ -129,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; @@ -254,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... @@ -691,13 +728,6 @@ ::message { markup => "Server does not support software update." }; } -# $self->register_face_handler ($exp_table, sub { -# my ($face) = @_; - -# $self->{exp_table} = $self->{json_coder}->decode (delete $face->{data}); -# $_->() for values %{ $self->{on_exp_update} || {} }; -# }); - () }); } @@ -936,17 +966,18 @@ } 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, @@ -976,14 +1007,24 @@ 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; @@ -1008,10 +1049,10 @@ } } - dc_connect $host, $port; + dc_connect $host, $port, $create; }; } else { - dc_connect $host, $port; + dc_connect $host, $port, $create; } } @@ -1854,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} = pack "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, form 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.", ), ); @@ -2016,7 +2097,7 @@ tooltip => "Use this to manually save configuration and UI layout when " . "autosave is disabled.", on_activate => sub { - DC::write_cfg; + DC::save_cfg; 0 } ); @@ -2662,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)"; @@ -2954,101 +3035,97 @@ }; # 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::load_cfg; + DC::upgrade_cfg; - DC::DB::Server::run; + DC::Audio::probe; - 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::Server::run; - DC::upgrade_cfg; + 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::DB::open_db; - DC::UI::set_layout ($::CFG->{layout}); + DC::UI::set_layout ($::CFG->{layout}); - my @args = @ARGV; + 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_/; + # 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'; + 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; + 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, - }; + $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, + }; + } } } - } - # 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 - ); + # 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 @@ -3063,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::loop; - 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