ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/Main.pm
(Generate patch)

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.23 by root, Fri Nov 16 12:03:26 2012 UTC

… …
25BEGIN { *time = \&EV::time } 25BEGIN { *time = \&EV::time }
26 26
27use List::Util qw(max min); 27use List::Util qw(max min);
28 28
29use Deliantra; 29use Deliantra;
30use Deliantra::Util;
30use Deliantra::Protocol::Constants; 31use Deliantra::Protocol::Constants;
31 32
32use AnyEvent::Util (); 33use AnyEvent::Util ();
33use AnyEvent::Socket (); 34use AnyEvent::Socket ();
34use AnyEvent::DNS (); 35use AnyEvent::DNS ();
… …
128our $MENUBAR; # the hbox at the top 129our $MENUBAR; # the hbox at the top
129our $MENUPOPUP; 130our $MENUPOPUP;
130our $BUTTONBAR; # the menu buttons 131our $BUTTONBAR; # the menu buttons
131our $METASERVER; 132our $METASERVER;
132our $LOGIN_BUTTON; 133our $LOGIN_BUTTON;
134our $LOGIN_ERROR;
133our $QUIT_DIALOG; 135our $QUIT_DIALOG;
134our $HOST_ENTRY; 136our $HOST_ENTRY;
135our $FULLSCREEN_ENABLE; 137our $FULLSCREEN_ENABLE;
136our $PICKUP_ENABLE; 138our $PICKUP_ENABLE;
137our $SERVER_INFO; 139our $SERVER_INFO;
… …
251 : "[<span foreground='#888'>num</span>]"; 253 : "[<span foreground='#888'>num</span>]";
252 254
253 # <tt> around next statement works around some bug that keeps the 255 # <tt> around next statement works around some bug that keeps the
254 # "font =>" from being used on windows 256 # "font =>" from being used on windows
255 $MODBOX->set_markup ("<tt>$markup</tt>"); 257 $MODBOX->set_markup ("<tt>$markup</tt>");
258}
259
260sub errorbox {
261 my ($msg) = @_;
262
263 status $msg;
264
265 my $dialog = new DC::UI::Toplevel
266 x => "center",
267 y => "center",
268 z => 200,
269 title => "Error",
270 child => my $vbox = new DC::UI::VBox,
271 has_close_button => 1,
272 on_delete => sub {
273 $_[0]->destroy;
274 },
275 ;
276
277 add $vbox new DC::UI::Label
278 align => 0.5,
279 ellipsise => 0,
280 text => $msg;
281
282 add $vbox new DC::UI::Button
283 expand => 1,
284 text => "OK",
285 on_activate => sub {
286 $dialog->destroy;
287 0
288 }
289 ;
290
291 $dialog->show;
256} 292}
257 293
258############################################################################# 294#############################################################################
259#TODO: maybe move into own audio module... 295#TODO: maybe move into own audio module...
260 296
… …
928 $vbox->add (@dialog); 964 $vbox->add (@dialog);
929 $dialog->show; 965 $dialog->show;
930} 966}
931 967
932sub dc_connect { 968sub dc_connect {
933 my ($host, $port) = @_; 969 my ($host, $port, $create) = @_;
934 970
935 my $mapw = List::Util::min 48, List::Util::max 11, int 1.5 + $WIDTH * $CFG->{mapsize} * 0.01 / 32; 971 my $mapw = List::Util::min 48, List::Util::max 11, int 1.5 + $WIDTH * $CFG->{mapsize} * 0.01 / 32;
936 my $maph = List::Util::min 48, List::Util::max 11, int 1.5 + $HEIGHT * $CFG->{mapsize} * 0.01 / 32; 972 my $maph = List::Util::min 48, List::Util::max 11, int 1.5 + $HEIGHT * $CFG->{mapsize} * 0.01 / 32;
937 973
938 $CONN = 974 $CONN =
939 new DC::Protocol 975 new DC::Protocol
940 host => $host, 976 host => $host,
941 port => $port, 977 port => $port,
978 create_login => $create,
942 user => $PROFILE->{user}, 979 user => $PROFILE->{user},
943 pass => $PROFILE->{password}, 980 pass => $PROFILE->{password},
944 mapw => $mapw, 981 mapw => $mapw,
945 maph => $maph, 982 maph => $maph,
946 983
… …
968 ota_update_check; 1005 ota_update_check;
969 1006
970 status "successfully connected to the server"; 1007 status "successfully connected to the server";
971 } else { 1008 } else {
972 undef $CONN; 1009 undef $CONN;
973 status "unable to connect: $!"; 1010 $LOGIN_ERROR->{fg} = [1, 0, 0];
1011 $LOGIN_ERROR->set_text ("Unable to connect to server: $!");
974 stop_game(); 1012 stop_game();
975 } 1013 }
976 }, 1014 },
1015
1016 on_addme => sub {
1017 my ($ok, $msg) = @_;
1018
1019 $LOGIN_ERROR->{fg} = $ok ? [0, 1, 0] : [1, 0, 0];
1020 $LOGIN_ERROR->set_text ($msg);
1021 },
977 ; 1022 ;
978} 1023}
979 1024
980sub start_game { 1025sub start_game($) {
1026 my ($create) = @_;
1027
981 status "logging in..."; 1028 status "logging in...";
982 1029
983 my $server = $PROFILE->{host} || $DEFAULT_SERVER; 1030 my $server = $PROFILE->{host} || $DEFAULT_SERVER;
984 my ($host, $port) = AnyEvent::Socket::parse_hostport $server, "deliantra=13327" 1031 my ($host, $port) = AnyEvent::Socket::parse_hostport $server, "deliantra=13327"
985 or return status "$server: unable to parse server address, try an empty field."; 1032 or return status "$server: unable to parse server address, try an empty field.";
… …
1000 status "dns failure, using hardcoded address"; 1047 status "dns failure, using hardcoded address";
1001 $host = "194.126.175.154"; 1048 $host = "194.126.175.154";
1002 } 1049 }
1003 } 1050 }
1004 1051
1005 dc_connect $host, $port; 1052 dc_connect $host, $port, $create;
1006 }; 1053 };
1007 } else { 1054 } else {
1008 dc_connect $host, $port; 1055 dc_connect $host, $port, $create;
1009 } 1056 }
1010} 1057}
1011 1058
1012sub stop_game { 1059sub stop_game {
1013 crash "stop_game"; 1060 crash "stop_game";
… …
1846 $vbox->add (new DC::UI::FancyFrame 1893 $vbox->add (new DC::UI::FancyFrame
1847 label => "Login Settings", 1894 label => "Login Settings",
1848 child => (my $table = new DC::UI::Table expand => 1, col_expand => [0, 1]), 1895 child => (my $table = new DC::UI::Table expand => 1, col_expand => [0, 1]),
1849 ); 1896 );
1850 1897
1898 my $nullpw = "\x00" x 16;
1899
1851 $table->add_at (0, 4, new DC::UI::Label align => 1, text => "Username"); 1900 $table->add_at (0, 0, new DC::UI::Label align => 1, text => "Username");
1852 $table->add_at (1, 4, new DC::UI::Entry 1901 $table->add_at (1, 0, new DC::UI::Entry
1853 text => $PROFILE->{user}, 1902 text => $PROFILE->{user},
1854 tooltip => "The name of your character on the server. The name is case-sensitive!", 1903 tooltip => "The name of your character on the server. The name is case-sensitive!",
1855 on_changed => sub { my ($self, $value) = @_; $PROFILE->{user} = $value; 1 } 1904 on_changed => sub { my ($self, $value) = @_; $PROFILE->{user} = $value; 1 }
1856 ); 1905 );
1857 1906
1858 $table->add_at (0, 5, new DC::UI::Label align => 1, text => "Password"); 1907 $table->add_at (0, 1, new DC::UI::Label align => 1, text => "Password");
1859 $table->add_at (1, 5, new DC::UI::Entry 1908 $table->add_at (1, 1, my $pw1 = new DC::UI::Entry
1860 text => $PROFILE->{password}, 1909 text => $PROFILE->{password} ? $nullpw : "",
1861 hidden => 1, 1910 hidden => 1,
1862 tooltip => "The password for your character.", 1911 tooltip => "The password for your character.",
1863 on_changed => sub { my ($self, $value) = @_; $PROFILE->{password} = $value; 1 } 1912 on_focus_in => sub {
1913 my ($self) = @_;
1914 $self->set_text ("")
1915 if $self->{text} eq $nullpw;
1916 0
1917 },
1918 on_changed => sub {
1919 my ($self, $value) = @_;
1920 $PROFILE->{password} = Deliantra::Util::hash_pw $value
1921 if length $value && $value ne $nullpw;
1922 1
1923 },
1864 ); 1924 );
1865 1925
1866 $table->add_at (1, 11, $LOGIN_BUTTON = new DC::UI::Button 1926 $table->add_at (1, 2, $LOGIN_BUTTON = new DC::UI::Button
1867 expand => 1, 1927 expand => 1,
1868 text => "Login / Register", 1928 text => "Login to Existing Account",
1869 tooltip => "This button will either login to the account configured above or register a new account.", 1929 tooltip => "This button will login to the account given by the <b>Username</b> and <b>Password</b> fields above.",
1870 on_activate => sub { 1930 on_activate => sub {
1871 $CONN ? stop_game 1931 $CONN ? stop_game
1872 : start_game; 1932 : start_game 0;
1873 1 1933 1
1874 }, 1934 },
1875 ); 1935 );
1876 1936
1937 $table->add_at (0, 3, new DC::UI::Label align => 1, text => "Password");
1938 $table->add_at (1, 3, my $pw2 = new DC::UI::Entry
1939 hidden => 1,
1940 tooltip => "The new password for your character",
1941 );
1942
1943 $table->add_at (1, 4, new DC::UI::Button
1944 expand => 1,
1945 text => "Create New Account",
1946 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.",
1947 on_activate => sub {
1948 if ($pw1->{text} ne $pw2->{text}) {
1949 $LOGIN_ERROR->{fg} = [1, 0, 0];
1950 $LOGIN_ERROR->set_text ("The passwords do not match - try to enter them again.");
1951 } else {
1952 $CONN or start_game 1;
1953 }
1954 1
1955 },
1956 );
1957
1958 $vbox->add (new DC::UI::FancyFrame
1959 label => "Server Message",
1960 tooltip => "The last message, or error, form the server.",
1961 child => ($LOGIN_ERROR = new DC::UI::Label valign => 0, ellipsise => 0),
1962 );
1963
1877 $vbox->add (new DC::UI::FancyFrame 1964 $vbox->add (new DC::UI::FancyFrame
1878 label => "How to Play", 1965 label => "How to Play",
1879 min_h => 240, 1966 min_h => 240,#d# should not be necessary - widget bug
1880 child => (new DC::UI::Label valign => 0, ellipsise => 0, 1967 child => (new DC::UI::Label valign => 0, ellipsise => 0,
1881 markup => 1968 markup =>
1882 "First select a suitable video resolution in the <b>Graphics</b> tab, above.\n\n" 1969 "First select a suitable video resolution in the <b>Graphics</b> tab, above.\n\n"
1883 . "Then register a new account (or use an existing one if you have one). " 1970 . "Then create a new account (or use an existing one if you have one).\n\n"
1884 . "To register an account, choose a username that hasn't been taken yet (just guess) and " 1971 . "To create an account, choose a username that hasn't been taken yet (just guess) and "
1885 . "try to log-in. Follow the instructions in the Log tab in the message window.", 1972 . "fill out the top two <b>Password</b> fields using the same password, then press <b>Create New Account</b>.",
1886 ), 1973 ),
1887 ); 1974 );
1888 1975
1889 $vbox 1976 $vbox
1890} 1977}

Diff Legend

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