[ViewVC] Diff of: cvs/deliantra/Deliantra-Client/DC/Main.pm

Comparing deliantra/Deliantra-Client/DC/Main.pm (file contents):
Revision 1.22 by root, Sun Nov 4 02:13:53 2012 UTC vs.
Revision 1.31 by root, Mon Nov 19 00:56:08 2018 UTC

 BEGIN { *time = \&EV::time }
 use List::Util qw(max min);
 use Deliantra;
+use Deliantra::Util;
 use Deliantra::Protocol::Constants;
 use AnyEvent::Util ();
 use AnyEvent::Socket ();
 use AnyEvent::DNS ();
 use DC::MessageDistributor;
 use DC::Pod;
 use DC::MapWidget;
 use DC::Macro;
+# printf "%5d %5d %5d %5d\n", $_, DC::minpot $_, DC::ld32 $_, 2 << ((DC::ld32 $_ - 1));
 $SIG{QUIT} = sub { Carp::cluck "QUIT" };
 $SIG{PIPE} = 'IGNORE';
 $EV::DIED = sub {
    crash "CRASH/EV::DIED: $@" => 0;
 our $MENUBAR;     # the hbox at the top
 our $MENUPOPUP;
 our $BUTTONBAR;   # the menu buttons
 our $METASERVER;
 our $LOGIN_BUTTON;
+our $LOGIN_ERROR;
 our $QUIT_DIALOG;
 our $HOST_ENTRY;
 our $FULLSCREEN_ENABLE;
 our $PICKUP_ENABLE;
 our $SERVER_INFO;
               : "[<span foreground='#888'>num</span>]";
    # <tt> around next statement works around some bug that keeps the
    # "font =>" from being used on windows
    $MODBOX->set_markup ("<tt>$markup</tt>");
+}
+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...
    audio_music_push;
 }
 sub audio_init {
    if ($CFG->{audio_enable}) {
-      DC::Audio::init $CFG->{audio_driver};
+      DC::Audio::init;
       if ($SDL_MIXER) {
          audio_music_finished;
       } else {
          status "Unable to open sound device: there will be no sound";
    $vbox->add (@dialog);
    $dialog->show;
 }
 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 =
       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",
                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;
    my ($host, $port) = AnyEvent::Socket::parse_hostport $server, "deliantra=13327"
       or return status "$server: unable to parse server address, try an empty field.";
                status "dns failure, using hardcoded address";
                $host = "194.126.175.154";
             }
          }
-         dc_connect $host, $port;
+         dc_connect $host, $port, $create;
       };
    } else {
-      dc_connect $host, $port;
+      dc_connect $host, $port, $create;
    }
 }
 sub stop_game {
    crash "stop_game";
       $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Compress Textures");
       $table->add_at (1, $row++, new DC::UI::CheckBox
          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 }
       );
       $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Fast & Ugly");
    $DELIANTRA_DEBUG ^= $_[0];
    if ($DELIANTRA_DEBUG & 16) {
       $BW_WATCHER = EV::periodic 0, 1, 0, sub {
          return unless $CONN;
-         debug sprintf "%8.2gKB/s", $CONN->{octets_in} / 1e3;
+         debug sprintf "%8.2gkB/s", $CONN->{octets_in} / 1e3;
          $CONN->{octets_in} = 0;
       };
    } else {
       undef $BW_WATCHER;
    }
    $vbox->add (new DC::UI::FancyFrame
       label => "Login Settings",
       child => (my $table = new DC::UI::Table expand => 1, col_expand => [0, 1]),
    );
+   my $nullpw = "\x00" x 16;
-   $table->add_at (0, 4, new DC::UI::Label align => 1, text => "Username");
+   $table->add_at (0, 0, new DC::UI::Label align => 1, text => "Username");
-   $table->add_at (1, 4, new DC::UI::Entry
+   $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 (0, 1, new DC::UI::Label align => 1, text => "Password");
-   $table->add_at (1, 5, new DC::UI::Entry
+   $table->add_at (1, 1, my $pw1 = new DC::UI::Entry
-      text => $PROFILE->{password},
+      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",
+      text => "Login to Existing Account",
-      tooltip => "This button will either login to the account configured above or register a new account.",
+      tooltip => "This button will login to the account given by the <b>Username</b> and <b>Password</b> 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 <b>Username</b> and the two <b>Password</b> fields above, using the same password for both <b>Password</b> 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 <b>Graphics</b> tab, above.\n\n"
-                     . "Then register a new account (or use an existing one if you have one). "
+                     . "Then create a new account (or use an existing one if you have one).\n\n"
-                     . "To register an account, choose a username that hasn't been taken yet (just guess) and "
+                     . "To create 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.",
+                     . "fill out the top two <b>Password</b> fields using the same password, then press <b>Create New Account</b>.",
                ),
    );
    $vbox
 }
    $table->add_at (0, ++$row, new DC::UI::Label align => 1, text => "Output-Rate");
    $table->add_at (1, $row, new DC::UI::Entry
       text => $CFG->{output_rate},
       tooltip => "The maximum bandwidth in bytes per second that the server should not exceed "
                . "when sending data. When 0 or unset, the server "
-               . "default will be used, which is usually around 100kb/s. Most servers will "
+               . "default will be used, which is usually around 100kB/s. Most servers will "
                . "dynamically find an optimal rate, so adjust this only when necessary.",
       on_changed => sub { $CFG->{output_rate} = $_[1]; 1 },
    );
    $vbox->add (new DC::UI::FancyFrame
    make_playerbook;
    $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) }],
+      ["…Statistics\tF2"   , sub { toggle_player_page ($::STATS_PAGE) }],
-      ["…Skills\tF3"        , sub { toggle_player_page ($::SKILL_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 }],
       ["Quit…"             , sub {
          if ($CONN) {
             open_quit_dialog;
          } else {
-            EV::unloop EV::UNLOOP_ALL;
+            EV::break EV::BREAK_ALL;
          }
       }],
    ]);
    $BUTTONBAR->add (new DC::UI::Button text => "Menu…",
    delete $animate_object{$widget};
 }
 $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 {
    DC::UI::full_refresh;
 };
 };
 #############################################################################
 $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::run {
          $CFG->{profile}{$profile} ||= {};
          $PROFILE = $CFG->{profile}{$profile};
          $PROFILE->{host} ||= "gameserver.deliantra.net";
-         $PROFILE->{host}     = $args[0] if @args > 0;
+         $PROFILE->{host}     =                                       $args[0] if @args > 0;
-         $PROFILE->{user}     = $args[1] if @args > 1;
+         $PROFILE->{user}     =                                       $args[1] if @args > 1;
-         $PROFILE->{password} = $args[2] if @args > 2;
+         $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) {
       };
       debug_toggle 0;
       delete $SIG{__DIE__};
-      EV::loop;
+      EV::run;
       DC::save_cfg if $CFG->{config_autosave};
       #video_shutdown;
       #audio_shutdown;

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC/Main.pm (file contents): Revision 1.22 by root, Sun Nov 4 02:13:53 2012 UTC vs. Revision 1.31 by root, Mon Nov 19 00:56:08 2018 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC/Main.pm (file contents):
Revision 1.22 by root, Sun Nov 4 02:13:53 2012 UTC vs.
Revision 1.31 by root, Mon Nov 19 00:56:08 2018 UTC