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

Comparing deliantra/Deliantra-Client/bin/deliantra (file contents):
Revision 1.77 by root, Fri Sep 26 04:45:48 2008 UTC vs.
Revision 1.105 by root, Sat Apr 3 02:58:25 2010 UTC

… …
17 $zip->extractMember ("SPLASH.bmp", "$ENV{PAR_TEMP}/SPLASH.bmp"); 17 $zip->extractMember ("SPLASH.bmp", "$ENV{PAR_TEMP}/SPLASH.bmp");
18 } 18 }
19 19
20 require Win32::GUI::SplashScreen; 20 require Win32::GUI::SplashScreen;
21 21
22 # initialise the resolver now, as vista forces us back to the desktop
23 # when doing this.
24 use AnyEvent::DNS ();
25 AnyEvent::DNS::resolver;
26
22 Win32::GUI::SplashScreen::Show ( 27 Win32::GUI::SplashScreen::Show (
23 -file => "$ENV{PAR_TEMP}/SPLASH.bmp", 28 -file => "$ENV{PAR_TEMP}/SPLASH.bmp",
24 ); 29 );
25 30
26 $startup_done = sub { 31 $startup_done = sub {
27 Win32::GUI::SplashScreen::Done (1); 32 Win32::GUI::SplashScreen::Done (1);
28 }; 33 };
29 } 34 }
30} 35}
31 36
32use strict; 37use common::sense;
33use utf8;
34 38
35use Carp 'verbose'; 39use Carp 'verbose';
36 40
37# do things only needed for single-binary version (par) 41# do things only needed for single-binary version (par)
38BEGIN { 42BEGIN {
… …
49 } 53 }
50 } 54 }
51 55
52 if ($^O eq "MSWin32") { 56 if ($^O eq "MSWin32") {
53 # pango is relocatable on win32 57 # pango is relocatable on win32
54 } elsif (-e "$root/pangoversion") {
55 open my $fh, "<:perlio", "$root/pangoversion"
56 or die "pangoversion: $!";
57 my $PANGO = <$fh>;
58 # unix, need to patch pango rc file
59 open my $fh, "<:perlio", "$root/usr/lib/pango/$PANGO/module-files.d/libpango1.0-0.modules"
60 or die "$root/usr/lib/$PANGO/module-files.d/libpango1.0-0.modules: $!";
61 local $/;
62 my $rc = <$fh>;
63 $rc =~ s/^\//$root\//gm; # replace abs paths by relative ones
64
65 mkdir "$root/pango-modules";
66 open my $fh, ">:perlio", "$root/pango-modules/pango.modules"
67 or die "$root/pango-modules/pango.modules: $!";
68 print $fh $rc;
69
70 $ENV{PANGO_RC_FILE} = "$root/pango.rc";
71 open my $fh, ">:perlio", $ENV{PANGO_RC_FILE}
72 or die "$ENV{PANGO_RC_FILE}: $!";
73 print $fh "[Pango]\nModuleFiles = $root/pango-modules\n";
74 } else { 58 } else {
75 # OS X 59 # OS X
76 $ENV{FC_CONFIG_FILE} = "$root/fonts.conf"; # no effect??!?!
77 $ENV{FC_CONFIG_DIR} = $root; # no effect??!?!
78 $ENV{PANGO_RC_FILE} = "$root/pango.rc"; 60 $ENV{PANGO_RC_FILE} = "$root/pango.rc";
79 $ENV{DYLD_LIBRARY_PATH} = $root; 61 $ENV{DYLD_LIBRARY_PATH} = $root;
80 chdir $root; # for pango modules, maybe other things 62 chdir $root; # for pango modules, maybe other things
81 } 63 }
82 64
83 unshift @INC, $root; 65 unshift @INC, $root;
84 } 66 }
85} 67}
86 68
87# prepend private library directory 69# prepend private library directory and prepare env
88BEGIN { 70BEGIN {
89 for (grep !ref, @INC) { 71 for (grep !ref, @INC) {
90 my $path = "$_/Deliantra/Client/private"; 72 my $path = "$_/Deliantra/Client/private";
91 if (-d $path) { 73 if (-d $path) {
92 unshift @INC, $path; 74 unshift @INC, $path;
… …
106 88
107use Deliantra; 89use Deliantra;
108use Deliantra::Protocol::Constants; 90use Deliantra::Protocol::Constants;
109 91
110use AnyEvent::Util (); 92use AnyEvent::Util ();
111use AnyEvent::DNS;
112use AnyEvent::Socket (); 93use AnyEvent::Socket ();
94use AnyEvent::DNS ();
113 95
114use Compress::LZF; 96use Compress::LZF;
115use JSON::XS; 97use JSON::XS;
116 98
117use DC; 99use DC;
… …
145 127
146$SIG{QUIT} = sub { Carp::cluck "QUIT" }; 128$SIG{QUIT} = sub { Carp::cluck "QUIT" };
147$SIG{PIPE} = 'IGNORE'; 129$SIG{PIPE} = 'IGNORE';
148 130
149$EV::DIED = sub { 131$EV::DIED = sub {
150 crash "CRASH/EV::DIED: $@" => 1; 132 crash "CRASH/EV::DIED: $@" => 0;
151 DC::fatal Carp::longmess $@; 133 DC::fatal Carp::longmess $@;
152}; 134};
153 135
154my $MAX_FPS = 60; 136my $MAX_FPS = 60;
137
138our $DEFAULT_SERVER = "gameserver.deliantra.net";
155 139
156our $META_SERVER = "http://metaserver.schmorp.de/current.json"; 140our $META_SERVER = "http://metaserver.schmorp.de/current.json";
157 141
158our $LAST_REFRESH; 142our $LAST_REFRESH;
159our $NOW; 143our $NOW;
… …
181 165
182our $MAP; 166our $MAP;
183our $MAPMAP; 167our $MAPMAP;
184our $MAPWIDGET; 168our $MAPWIDGET;
185our $COMPLETER; 169our $COMPLETER;
186our $BUTTONBAR; 170our $MENUFRAME; # the rectangle at the top
171our $MENUBAR; # the hbox at the top
172our $MENUPOPUP;
173our $BUTTONBAR; # the menu buttons
187our $METASERVER; 174our $METASERVER;
188our $LOGIN_BUTTON; 175our $LOGIN_BUTTON;
189our $QUIT_DIALOG; 176our $QUIT_DIALOG;
190our $HOST_ENTRY; 177our $HOST_ENTRY;
191our $FULLSCREEN_ENABLE; 178our $FULLSCREEN_ENABLE;
… …
217our $FLOORBOX; 204our $FLOORBOX;
218our $GAUGES; 205our $GAUGES;
219our $STATWIDS; 206our $STATWIDS;
220 207
221our $SDL_ACTIVE; 208our $SDL_ACTIVE;
222our %SDL_CB; 209our @SDL_CB;
223 210
224our $ALT_ENTER_MESSAGE; 211our $ALT_ENTER_MESSAGE;
225our $STATUSBOX; 212our $STATUSBOX;
226our $MODBOX; 213our $MODBOX;
227our $DEBUG_STATUS; 214our $DEBUG_STATUS;
… …
235# write a crash message blockingly to the socket, if possible 222# write a crash message blockingly to the socket, if possible
236# this is a bit too complicated for my tastes, but it was easy. 223# this is a bit too complicated for my tastes, but it was easy.
237*crash = sub($;$) { 224*crash = sub($;$) {
238 my ($msg, $backtrace) = @_; 225 my ($msg, $backtrace) = @_;
239 226
227 warn $msg;
228
240 return unless $CONN; 229 return unless $CONN;
241 230
242 my $fh = $CONN->{fh} 231 my $fh = $CONN->{fh}
243 or return; 232 or return;
244 233
… …
254 243
255 # backtrace as second step, in case it crashes, too 244 # backtrace as second step, in case it crashes, too
256 crash Carp::longmess "$msg\nbacktrace, for client version $DC::VERSION, generated" 245 crash Carp::longmess "$msg\nbacktrace, for client version $DC::VERSION, generated"
257 if $backtrace; 246 if $backtrace;
258}; 247};
248
249sub clienterror($;$) {
250 my ($msg, $backtrace) = @_;
251
252 warn $msg;
253
254 return unless $CONN;
255
256 $CONN->send_exti_msg (clientlog => $msg);
257 $CONN->send_exti_msg (clientlog => Carp::longmess "$msg\nbacktrace, for client version $DC::VERSION, generated") if $backtrace;
258}
259 259
260############################################################################# 260#############################################################################
261 261
262sub status { 262sub status {
263 $STATUSBOX->add (DC::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]); 263 $STATUSBOX->add (DC::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
… …
345 or return; 345 or return;
346 346
347 $meta->{data} 347 $meta->{data}
348 or return; 348 or return;
349 349
350 # if its a jingle, play it as ambient music 350 # if it's a jingle, play it as ambient music
351 if ($meta->{data}{jingle}) { 351 if ($meta->{data}{jingle}) {
352 if (delete $AUDIO_PLAY{$face}) { # take the jingle out of the sound queue 352 if (delete $AUDIO_PLAY{$face}) { # take the jingle out of the sound queue
353 push @MUSIC_JINGLE, $meta; # push it oto the music/jingle queue 353 push @MUSIC_JINGLE, $meta; # push it unto the music/jingle queue
354 &audio_music_push ($face); 354 &audio_music_push ($face);
355 } 355 }
356 } else { 356 } else {
357 # fetch from database 357 # fetch from database
358 DC::DB::get res_data => $meta->{name}, sub { 358 DC::DB::get res_data => $meta->{name}, sub {
359 my $rwops = new DC::RW $_[0]; 359 my $rwops = new DC::RW $_[0];
360 my $chunk = new DC::MixChunk $rwops 360 my $chunk = new DC::MixChunk $rwops
361 or Carp::confess "sound face " . (JSON::XS::encode_json $meta) . " unloadable: " . DC::Mix_GetError; 361 or Carp::confess "sound face " . (JSON::XS::encode_json $meta) . " (" . (unpack "H64", $_[0]) . ") unloadable: " . DC::Mix_GetError;
362 $chunk->volume (($meta->{data}{volume} || 1) * 128); 362 $chunk->volume (($meta->{data}{volume} || 1) * 128);
363 $AUDIO_CHUNK{$face} = $chunk; 363 $AUDIO_CHUNK{$face} = $chunk;
364 364
365 audio_sound_push ($face); 365 audio_sound_push ($face);
366 }; 366 };
… …
413 413
414 audio_music_update_volume; 414 audio_music_update_volume;
415 415
416 $MUSIC_PLAYING_DATA = \$_[0]; 416 $MUSIC_PLAYING_DATA = \$_[0];
417 417
418 $meta->{path} or length $_[0]
419 or return clienterror "empty music face from res_data ($meta->{face})";#d#
420
418 my $rwops = $meta->{path} 421 my $rwops = $meta->{path}
419 ? new_from_file DC::RW $meta->{path} 422 ? (new_from_file DC::RW $meta->{path} or return clienterror "unable to load music face $meta->{path}: $!")#d#clienterror
420 : new DC::RW $$MUSIC_PLAYING_DATA; 423 : new DC::RW $$MUSIC_PLAYING_DATA;
421 424
422 $MUSIC_PLAYER = new DC::MixMusic $rwops 425 $MUSIC_PLAYER = new DC::MixMusic $rwops
423 or Carp::confess "music face $meta->{face} unloadable: " . DC::Mix_GetError; 426 or return clienterror "music face $meta->{face} unloadable: " . DC::Mix_GetError => 1;
424 427
425 my $NOW = time; 428 my $NOW = time;
426 429
427 if ($MUSIC_PLAYING_META->{stop_time} > $NOW - $MUSIC_RESUME) { 430 if ($MUSIC_PLAYING_META->{stop_time} > $NOW - $MUSIC_RESUME) {
428 my $pos = $MUSIC_PLAYING_META->{stop_pos}; 431 my $pos = $MUSIC_PLAYING_META->{stop_pos};
… …
537 sub audio_tab_update; 540 sub audio_tab_update;
538 audio_tab_update; 541 audio_tab_update;
539} 542}
540 543
541sub audio_shutdown { 544sub audio_shutdown {
545 if ($SDL_MIXER) {
546 DC::MixMusic::halt;
547 DC::Mix_AllocateChannels 0;
548 }
549
542 undef $MUSIC_PLAYER; 550 undef $MUSIC_PLAYER;
543 undef $MUSIC_PLAYING_META; 551 undef $MUSIC_PLAYING_META;
544 undef $MUSIC_PLAYING_DATA; 552 undef $MUSIC_PLAYING_DATA;
545 553
546 $MUSIC_WANT = []; 554 $MUSIC_WANT = [];
… …
786} 794}
787 795
788sub dc_connect { 796sub dc_connect {
789 my ($host, $port) = @_; 797 my ($host, $port) = @_;
790 798
791 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32; 799 my $mapw = List::Util::min 48, List::Util::max 11, int 1.5 + $WIDTH * $CFG->{mapsize} * 0.01 / 32;
800 my $maph = List::Util::min 48, List::Util::max 11, int 1.5 + $HEIGHT * $CFG->{mapsize} * 0.01 / 32;
792 801
793 $CONN = 802 $CONN =
794 new DC::Protocol 803 new DC::Protocol
795 host => $host, 804 host => $host,
796 port => $port, 805 port => $port,
797 user => $PROFILE->{user}, 806 user => $PROFILE->{user},
798 pass => $PROFILE->{password}, 807 pass => $PROFILE->{password},
799 mapw => $mapsize, 808 mapw => $mapw,
800 maph => $mapsize, 809 maph => $maph,
801 810
802 client => "$DC::VERSION $] $^O", 811 client => "$DC::VERSION $] $^O",
803 812
804 map_widget => $MAPWIDGET, 813 map_widget => $MAPWIDGET,
805 statusbox => $STATUSBOX, 814 statusbox => $STATUSBOX,
… …
813 822
814 on_connect => sub { 823 on_connect => sub {
815 if ($_[0]) { 824 if ($_[0]) {
816 DC::lowdelay fileno $CONN->{fh}; 825 DC::lowdelay fileno $CONN->{fh};
817 826
818 status "login successful"; 827 status "successfully connected to the server";
819 } else { 828 } else {
820 undef $CONN; 829 undef $CONN;
821 status "unable to connect: $!"; 830 status "unable to connect: $!";
822 stop_game(); 831 stop_game();
823 } 832 }
… …
825 ; 834 ;
826} 835}
827 836
828sub start_game { 837sub start_game {
829 status "logging in..."; 838 status "logging in...";
839
840 my $server = $PROFILE->{host} || $DEFAULT_SERVER;
841 my ($host, $port) = AnyEvent::Socket::parse_hostport $server, "deliantra=13327"
842 or return status "$server: unable to parse server address, try an empty field.";
830 843
831 $LOGIN_BUTTON->set_text ("Logout"); 844 $LOGIN_BUTTON->set_text ("Logout");
832 $SETUP_DIALOG->hide; 845 $SETUP_DIALOG->hide;
833
834 my ($host, $port) = AnyEvent::Socket::parse_hostport $PROFILE->{host}, "deliantra=13327";
835 846
836 $MAP = new DC::Map; 847 $MAP = new DC::Map;
837 848
838 # hack to make SURE we find the IP address all right 849 # hack to make SURE we find the IP address all right
839 # can be removed once AnyEvent::DNS is proven stable. 850 # can be removed once AnyEvent::DNS is proven stable.
840 if ($host eq "gameserver.deliantra.net") { 851 if ($host eq "gameserver.deliantra.net") {
841 AnyEvent::DNS::a "dnstest.deliantra.net", sub { 852 AnyEvent::DNS::a "dnstest.deliantra.net", sub {
842 if ($_[0] ne "80.101.114.108") { # Perl 853 if ($_[0] ne "80.101.114.108") { # Perl
854 status "dns failure, trying differently";
855 $host = eval { Socket::inet_ntoa Socket::inet_aton "gameserver.deliantra.net" };
856 unless (defined $host) {
843 status "dns failure, using hardcoded address"; 857 status "dns failure, using hardcoded address";
844 $host = "129.13.162.95"; 858 $host = "129.13.162.95";
859 }
845 } 860 }
846 861
847 dc_connect $host, $port; 862 dc_connect $host, $port;
848 }; 863 };
849 } else { 864 } else {
… …
916 931
917 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Video Mode"); 932 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Video Mode");
918 $table->add_at (1, $row++, my $hbox = new DC::UI::HBox); 933 $table->add_at (1, $row++, my $hbox = new DC::UI::HBox);
919 934
920 $hbox->add ($MODE_SLIDER = new DC::UI::Slider 935 $hbox->add ($MODE_SLIDER = new DC::UI::Slider
936 c_rescale => 1,
921 force_w => $WIDTH * 0.1, expand => 1, 937 force_w => $WIDTH * 0.1, expand => 1,
922 range => [ ($CFG->{sdl_mode}) x 3 ], 938 range => [ ($CFG->{sdl_mode}) x 3 ],
923 tooltip => $vidmode_tooltip); 939 tooltip => $vidmode_tooltip);
924 $hbox->add (my $mode_label = new DC::UI::Label 940 $hbox->add (my $mode_label = new DC::UI::Label
925 height => 0.8, template => "9999x9999@9+9", 941 height => 0.8, template => "9999x9999@9+9",
… …
953 ); 969 );
954 970
955 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Forbid Alpha"); 971 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Forbid Alpha");
956 $table->add_at (1, $row++, new DC::UI::CheckBox 972 $table->add_at (1, $row++, new DC::UI::CheckBox
957 state => $CFG->{disable_alpha}, 973 state => $CFG->{disable_alpha},
958 tooltip => "Forbid off the use of the alpha channel. This makes Deliantra look a lot worse " 974 tooltip => "Forbid the use of the alpha channel. This makes Deliantra look a lot worse "
959 . "by disabling a number of textures and transparency effects. Normally, these " 975 . "by disabling a number of textures and transparency effects. Normally, these "
960 . "effects do not cost a lot of resources, but some graphics cards might fall " 976 . "effects do not cost a lot of resources, but some graphics cards might fall "
961 . "back to extremely slow rendering if this is enabled. If disabling this option " 977 . "back to extremely slow rendering if this is enabled. If disabling this option "
962 . "noticably improves the framerate of the client please report this! " 978 . "noticably improves the framerate of the client please report this! "
963 . "<b>If you experience extremely low framerates and your card should do better, try this option.</b>", 979 . "<b>If you experience extremely low framerates and your card should do better, try this option.</b>",
… …
1017 . "If you have a very slow system, non-accelerated drivers or plain dislike smooth scrolling, " 1033 . "If you have a very slow system, non-accelerated drivers or plain dislike smooth scrolling, "
1018 . "then disable this option. Changes take effect immdiately.", 1034 . "then disable this option. Changes take effect immdiately.",
1019 on_changed => sub { my ($self, $value) = @_; $CFG->{smooth_movement} = $value; 0 } 1035 on_changed => sub { my ($self, $value) = @_; $CFG->{smooth_movement} = $value; 0 }
1020 ); 1036 );
1021 1037
1038 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Smooth Transitions");
1039 $table->add_at (1, $row++, new DC::UI::CheckBox
1040 state => $CFG->{smooth_transitions},
1041 tooltip => "<b>Smooth Transitions</b> tries to blend the fog of war and lighting smoothly between updates. "
1042 . "If you have a very slow system, non-accelerated drivers or plain dislike smooth scrolling, "
1043 . "then disable this option. Requires Smooth Movement and OpenGL Multitexturing. Changes take effect immdiately.",
1044 on_changed => sub { my ($self, $value) = @_; $CFG->{smooth_transitions} = $value; 0 }
1045 );
1046
1047
1022 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Map Scale"); 1048 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Map Scale");
1023 $table->add_at (1, $row++, new DC::UI::Slider 1049 $table->add_at (1, $row++, new DC::UI::Slider
1024 range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1], 1050 range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
1025 tooltip => "Enlarge or shrink the displayed map. Changes are instant.", 1051 tooltip => "Enlarge or shrink the displayed map. Changes are instant.",
1026 on_changed => sub { my ($self, $value) = @_; $CFG->{map_scale} = 2 ** $value; 0 } 1052 on_changed => sub { my ($self, $value) = @_; $CFG->{map_scale} = 2 ** $value; 0 }
… …
1038 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Fog of War"); 1064 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Fog of War");
1039 $table->add_at (1, $row++, new DC::UI::CheckBox 1065 $table->add_at (1, $row++, new DC::UI::CheckBox
1040 state => $CFG->{fow_enable}, 1066 state => $CFG->{fow_enable},
1041 tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.", 1067 tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",
1042 on_changed => sub { my ($self, $value) = @_; $CFG->{fow_enable} = $value; 0 } 1068 on_changed => sub { my ($self, $value) = @_; $CFG->{fow_enable} = $value; 0 }
1069 );
1070
1071 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "FoW Pattern");
1072 $table->add_at (1, $row++, new DC::UI::ImageButton
1073 tex => $DC::MapWidget::TEX_HIDDEN[$CFG->{fow_texture}],
1074 bg => [0.3, 0.3, 0.2],
1075 force_w => 64,
1076 force_h => 64,
1077 tooltip => "<b>Fog of War Pattern.</b> The pattern that is overlaid over areas hidden from view. Click to cycle through various alternatives. Changes are instant.",
1078 on_activate => sub {
1079 my ($self) = @_;
1080 $CFG->{fow_texture} = ($CFG->{fow_texture} + 1) % @DC::MapWidget::TEX_HIDDEN;
1081 $self->set_texture ($DC::MapWidget::TEX_HIDDEN[$CFG->{fow_texture}]);
1082 $MAPWIDGET->update;
1083 }
1043 ); 1084 );
1044 1085
1045 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "FoW Intensity"); 1086 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "FoW Intensity");
1046 $table->add_at (1, $row++, new DC::UI::Slider 1087 $table->add_at (1, $row++, new DC::UI::Slider
1047 range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256], 1088 range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],
… …
1099 1140
1100 my $text = !$freq 1141 my $text = !$freq
1101 ? "audio is off" 1142 ? "audio is off"
1102 : "audio is enabled\n" 1143 : "audio is enabled\n"
1103 . "frequency (Hz): $freq\n" 1144 . "frequency (Hz): $freq\n"
1104 . "channels: $chans"; 1145 . "channels: $chans\n"
1146 . "chunk decoders available: " . (join ", ", DC::MixChunk::decoders) . "\n"
1147 . "music decoders available: " . (join ", ", DC::MixMusic::decoders);
1105 1148
1106 $AUDIO_INFO->set_text ($text); 1149 $AUDIO_INFO->set_text ($text);
1107} 1150}
1108 1151
1109sub audio_setup { 1152sub audio_setup {
… …
1249} 1292}
1250 1293
1251sub make_gauge_window { 1294sub make_gauge_window {
1252 my $gh = int $HEIGHT * $CFG->{gauge_size}; 1295 my $gh = int $HEIGHT * $CFG->{gauge_size};
1253 1296
1254 my $win = new DC::UI::Frame ( 1297 $GAUGES->{win} = my $win = new DC::UI::Frame (
1255 force_x => 0, 1298 force_x => 0,
1256 force_y => "max", 1299 force_y => "max",
1257 force_w => $WIDTH, 1300 force_w => $WIDTH,
1258 force_h => $gh, 1301 force_h => $gh,
1259 ); 1302 );
… …
1275 (new DC::UI::Empty expand => 1), 1318 (new DC::UI::Empty expand => 1),
1276 (my $hb = new DC::UI::HBox), 1319 (my $hb = new DC::UI::HBox),
1277 ], 1320 ],
1278 ); 1321 );
1279 1322
1280 $hb->add (my $hg = new DC::UI::Gauge type => 'hp', tooltip => "#stat_health"); 1323 $hb->add ($GAUGES->{hp} = new DC::UI::Gauge type => 'hp', tooltip => "#stat_health");
1281 $hb->add (my $mg = new DC::UI::Gauge type => 'mana', tooltip => "#stat_mana"); 1324 $hb->add ($GAUGES->{mana} = new DC::UI::Gauge type => 'mana', tooltip => "#stat_mana");
1282 $hb->add (my $gg = new DC::UI::Gauge type => 'grace', tooltip => "#stat_grace"); 1325 $hb->add ($GAUGES->{grace} = new DC::UI::Gauge type => 'grace', tooltip => "#stat_grace");
1283 $hb->add (my $fg = new DC::UI::Gauge type => 'food', tooltip => "#stat_food"); 1326 $hb->add ($GAUGES->{food} = new DC::UI::Gauge type => 'food', tooltip => "#stat_food");
1284
1285 $vbox->add (my $exp = new DC::UI::Label align => 1, can_hover => 1, can_events => 1, tooltip => "#stat_exp");
1286 $vbox->add (my $prg = new DC::UI::ExperienceProgress);
1287 $vbox->add (my $sklprg = new DC::UI::ExperienceProgress);
1288 $vbox->add (my $rng = new DC::UI::Label align => 1, can_hover => 1, can_events => 1, tooltip => "#stat_ranged");
1289
1290 $GAUGES = {
1291 exp => $exp, prg => $prg, sklprg => $sklprg,
1292 win => $win, range => $rng,
1293 hp => $hg, mana => $mg, grace => $gg, food => $fg,
1294 };
1295 1327
1296 &set_gauge_window_fontsize; 1328 &set_gauge_window_fontsize;
1297 1329
1298 $win 1330 $win
1299} 1331}
… …
1640 child => (my $table = new DC::UI::Table expand => 1, col_expand => [0, 1]), 1672 child => (my $table = new DC::UI::Table expand => 1, col_expand => [0, 1]),
1641 ); 1673 );
1642 1674
1643 $table->add_at (0, 4, new DC::UI::Label align => 1, text => "Username"); 1675 $table->add_at (0, 4, new DC::UI::Label align => 1, text => "Username");
1644 $table->add_at (1, 4, new DC::UI::Entry 1676 $table->add_at (1, 4, new DC::UI::Entry
1645 text => $CFG->{profile}{default}{user}, 1677 text => $PROFILE->{user},
1646 tooltip => "The name of your character on the server.", 1678 tooltip => "The name of your character on the server. The name is case-sensitive!",
1647 on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{user} = $value; 1 } 1679 on_changed => sub { my ($self, $value) = @_; $PROFILE->{user} = $value; 1 }
1648 ); 1680 );
1649 1681
1650 $table->add_at (0, 5, new DC::UI::Label align => 1, text => "Password"); 1682 $table->add_at (0, 5, new DC::UI::Label align => 1, text => "Password");
1651 $table->add_at (1, 5, new DC::UI::Entry 1683 $table->add_at (1, 5, new DC::UI::Entry
1652 text => $CFG->{profile}{default}{password}, 1684 text => $PROFILE->{password},
1653 hidden => 1, 1685 hidden => 1,
1654 tooltip => "The password for your character.", 1686 tooltip => "The password for your character.",
1655 on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{password} = $value; 1 } 1687 on_changed => sub { my ($self, $value) = @_; $PROFILE->{password} = $value; 1 }
1656 ); 1688 );
1657 1689
1658 $table->add_at (1, 11, $LOGIN_BUTTON = new DC::UI::Button 1690 $table->add_at (1, 11, $LOGIN_BUTTON = new DC::UI::Button
1659 expand => 1, 1691 expand => 1,
1660 text => "Login / Register", 1692 text => "Login / Register",
… …
1696 $table->add_at (1, $row, my $vbox = new DC::UI::VBox); 1728 $table->add_at (1, $row, my $vbox = new DC::UI::VBox);
1697 1729
1698 $vbox->add ( 1730 $vbox->add (
1699 $HOST_ENTRY = new DC::UI::Entry 1731 $HOST_ENTRY = new DC::UI::Entry
1700 expand => 1, 1732 expand => 1,
1701 text => $CFG->{profile}{default}{host}, 1733 text => $PROFILE->{host},
1702 tooltip => "The hostname or ip address of the Deliantra server to connect to (e.g. <b>gameserver.deliantra.net</b>)", 1734 tooltip => "The hostname or ip address of the Deliantra server to connect to (e.g. <b>gameserver.deliantra.net</b>)",
1703 on_changed => sub { 1735 on_changed => sub {
1704 my ($self, $value) = @_; 1736 my ($self, $value) = @_;
1705 $CFG->{profile}{default}{host} = $value; 1737 $PROFILE->{host} = $value;
1706 1 1738 1
1707 } 1739 }
1708 ); 1740 );
1709 1741
1710 if (0) { #d# disabled 1742 if (0) { #d# disabled
… …
1753 1785
1754 my $row = 0; 1786 my $row = 0;
1755 1787
1756 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Tip of the day"); 1788 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Tip of the day");
1757 $table->add_at (1, $row++, new DC::UI::CheckBox 1789 $table->add_at (1, $row++, new DC::UI::CheckBox
1790 c_colspan => 2,
1758 state => $CFG->{show_tips}, 1791 state => $CFG->{show_tips},
1759 tooltip => "Show the <b>Tip of the day</b> window at startup?", 1792 tooltip => "Show the <b>Tip of the day</b> window at startup?",
1760 on_changed => sub { 1793 on_changed => sub {
1761 my ($self, $value) = @_; 1794 my ($self, $value) = @_;
1762 $CFG->{show_tips} = $value; 1795 $CFG->{show_tips} = $value;
… …
1764 } 1797 }
1765 ); 1798 );
1766 1799
1767 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Message Window Size"); 1800 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Message Window Size");
1768 $table->add_at (1, $row++, my $saycmd = new DC::UI::Entry 1801 $table->add_at (1, $row++, my $saycmd = new DC::UI::Entry
1802 c_colspan => 2,
1769 text => $CFG->{logview_max_par}, 1803 text => $CFG->{logview_max_par},
1770 tooltip => "This is maximum number of messages remembered in the <b>Message</b> window. If the server " 1804 tooltip => "This is maximum number of messages remembered in the <b>Message</b> window. If the server "
1771 . "sends more messages than this number, older messages get removed to save memory and " 1805 . "sends more messages than this number, older messages get removed to save memory and "
1772 . "computing time. A value of <b>0</b> disables this feature, but that is not recommended.", 1806 . "computing time. A value of <b>0</b> disables this feature, but that is not recommended.",
1773 on_changed => sub { 1807 on_changed => sub {
… …
1775 $MESSAGE_DIST->set_max_par ($CFG->{logview_max_par} = $value*1); 1809 $MESSAGE_DIST->set_max_par ($CFG->{logview_max_par} = $value*1);
1776 0 1810 0
1777 }, 1811 },
1778 ); 1812 );
1779 1813
1814 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Config Autosave");
1815 $table->add_at (1, $row, new DC::UI::CheckBox
1816 state => $CFG->{config_autosave},
1817 tooltip => "Normally, configuration settings and the user interface layout "
1818 . "are saved on client exit. You can disable this behaviour by "
1819 . "unchecking this checkbox.",
1820 on_changed => sub {
1821 my ($self, $value) = @_;
1822 $CFG->{config_autosave} = $value;
1823 0
1824 }
1825 );
1826 $table->add_at (2, $row++, new DC::UI::Button
1827 text => "Save Now",
1828 tooltip => "Use this to manually save configuration and UI layout when "
1829 . "autosave is disabled.",
1830 on_activate => sub {
1831 DC::write_cfg;
1832 0
1833 }
1834 );
1835
1780 $table 1836 $table
1781} 1837}
1782 1838
1783sub autopickup_setup { 1839sub autopickup_setup {
1784 my $r = new DC::UI::ScrolledWindow ( 1840 my $r = new DC::UI::ScrolledWindow (
… …
1790 col_expand => [0, 1, 0, 1], 1846 col_expand => [0, 1, 0, 1],
1791 ); 1847 );
1792 1848
1793 for ( 1849 for (
1794 ["General", 0, 0, 1850 ["General", 0, 0,
1795 ["Enable autopickup" => PICKUP_NEWMODE, \$PICKUP_ENABLE],
1796 ["Inhibit autopickup" => PICKUP_INHIBIT], 1851# ["Inhibit autopickup" => PICKUP_INHIBIT],
1797 ["Stop before pickup" => PICKUP_STOP], 1852 ["Stop before pickup" => PICKUP_STOP],
1798 ["Debug autopickup" => PICKUP_DEBUG], 1853 ["Debug autopickup" => PICKUP_DEBUG],
1799 ], 1854 ],
1800 ["Weapons", 0, 6, 1855 ["Weapons", 0, 6,
1801 ["All weapons" => PICKUP_ALLWEAPON], 1856 ["All weapons" => PICKUP_ALLWEAPON],
… …
1849 $::CFG->{pickup} |= $mask; 1904 $::CFG->{pickup} |= $mask;
1850 } else { 1905 } else {
1851 $::CFG->{pickup} &= ~$mask; 1906 $::CFG->{pickup} &= ~$mask;
1852 } 1907 }
1853 1908
1854 $::CONN->send_command ("pickup $::CFG->{pickup}") 1909 $::CONN->send_pickup ($::CFG->{pickup})
1855 if defined $::CONN; 1910 if defined $::CONN;
1856 1911
1857 0 1912 0
1858 }); 1913 });
1859 1914
… …
1876 }); 1931 });
1877 1932
1878 $table->add_at (3, 18, new DC::UI::Button 1933 $table->add_at (3, 18, new DC::UI::Button
1879 text => "set", 1934 text => "set",
1880 on_activate => sub { 1935 on_activate => sub {
1881 $::CONN->send_command ("pickup $::CFG->{pickup}") 1936 $::CONN->send_pickup ($::CFG->{pickup})
1882 if defined $::CONN; 1937 if defined $::CONN;
1883 0 1938 0
1884 }); 1939 });
1885 1940
1886 $r 1941 $r
… …
1999 $PL_NOTEBOOK->set_current_page ($widget); 2054 $PL_NOTEBOOK->set_current_page ($widget);
2000 $PL_WINDOW->show; 2055 $PL_WINDOW->show;
2001 } 2056 }
2002} 2057}
2003 2058
2004sub player_window { 2059sub make_playerbook {
2005 my $plwin = $PL_WINDOW = new DC::UI::Toplevel 2060 my $plwin = $PL_WINDOW = new DC::UI::Toplevel
2006 x => "center", 2061 x => "center",
2007 y => "center", 2062 y => "center",
2008 force_w => $WIDTH * 9/10, 2063 force_w => $WIDTH * 9/10,
2009 force_h => $HEIGHT * 9/10, 2064 force_h => $HEIGHT * 9/10,
… …
2043 "License, Author and Source info for media sent by the server."); 2098 "License, Author and Source info for media sent by the server.");
2044 2099
2045 $ntb->set_current_page ($INVENTORY_PAGE); 2100 $ntb->set_current_page ($INVENTORY_PAGE);
2046 2101
2047 $plwin->add ($ntb); 2102 $plwin->add ($ntb);
2048 $plwin
2049} 2103}
2050 2104
2051sub keyboard_setup { 2105sub keyboard_setup {
2052 DC::Macro::keyboard_setup 2106 DC::Macro::keyboard_setup
2053} 2107}
2054 2108
2055sub help_window { 2109sub make_help_window {
2056 my $win = new DC::UI::Toplevel 2110 my $win = new DC::UI::Toplevel
2057 x => 'center', 2111 x => 'center',
2058 y => 'center', 2112 y => 'center',
2059 z => 4, 2113 z => 4,
2060 name => 'doc_browser', 2114 name => 'doc_browser',
… …
2149 2203
2150 $load_node->((DC::Pod::find @path)[0]); 2204 $load_node->((DC::Pod::find @path)[0]);
2151 $win->show; 2205 $win->show;
2152 }; 2206 };
2153 2207
2154 $win 2208 $HELP_WINDOW = $win;
2155}
2156
2157sub open_string_query {
2158 my ($title, $cb, $txt, $tooltip) = @_;
2159 my $dialog = new DC::UI::Toplevel
2160 x => "center",
2161 y => "center",
2162 z => 50,
2163 force_w => $WIDTH * 4/5,
2164 title => $title;
2165
2166 $dialog->add (
2167 my $e = new DC::UI::Entry
2168 on_activate => sub { $cb->(@_); $dialog->hide; 0 },
2169 on_key_down => sub { $_[1]->{sym} == 27 and $dialog->hide; 0 },
2170 tooltip => $tooltip
2171 );
2172
2173 $e->grab_focus;
2174 $e->set_text ($txt) if $txt;
2175 $dialog->show;
2176} 2209}
2177 2210
2178sub open_quit_dialog { 2211sub open_quit_dialog {
2179 unless ($QUIT_DIALOG) { 2212 unless ($QUIT_DIALOG) {
2180 $QUIT_DIALOG = new DC::UI::Toplevel 2213 $QUIT_DIALOG = new DC::UI::Toplevel
… …
2213 2246
2214 $QUIT_DIALOG->show; 2247 $QUIT_DIALOG->show;
2215 $QUIT_DIALOG->grab_focus; 2248 $QUIT_DIALOG->grab_focus;
2216} 2249}
2217 2250
2251sub make_menubar {
2252 $MENUFRAME = new DC::UI::Toplevel
2253 border => 0,
2254 force_x => 0,
2255 force_y => 0,
2256 force_w => $::WIDTH,
2257 child => ($MENUBAR = new DC::UI::HBox),
2258 ;
2259
2260 $MENUBAR->add ($BUTTONBAR = new DC::UI::Buttonbar);
2261
2262 # XXX: this has to be done before make_stats_window as make_stats_window calls update_stats_window which updated the gauges also X-D
2263 make_gauge_window->show;
2264
2265# $BUTTONBAR->add (new DC::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW,
2266# tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
2267
2268 make_playerbook;
2269
2270 $MENUPOPUP = DC::UI::Menu->new (items => [
2271 ["Setup…\tF9" , sub { $SETUP_DIALOG->toggle_visibility }],
2272 ["Playerbook…\tTab" , sub { $PL_WINDOW ->toggle_visibility }],
2273 ["…Statistics\tF2" , sub { toggle_player_page ($::STATS_PAGE) }],
2274 ["…Skills\tF3" , sub { toggle_player_page ($::SKILL_PAGE) }],
2275 ["…Spells\tF4" , sub { toggle_player_page ($::SPELL_PAGE) }],
2276 ["…Inventory\tF5" , sub { toggle_player_page ($::INVENTORY_PAGE) }],
2277 ["Help Browser…\tF1" , sub { $HELP_WINDOW ->toggle_visibility }],
2278 ["Quit…" , sub {
2279 if ($CONN) {
2280 open_quit_dialog;
2281 } else {
2282 EV::unloop EV::UNLOOP_ALL;
2283 }
2284 }],
2285 ]);
2286
2287 $BUTTONBAR->add (new DC::UI::Button text => "Menu…",
2288 tooltip => "Shows the main menu",
2289 on_button_down => sub {
2290 my ($self, $ev) = @_;
2291 local $ev->{x} = 0;
2292 local $ev->{y} = 0;
2293 $MENUPOPUP->popup ($ev);
2294 },
2295 );
2296
2297 $MENUBAR->add ($GAUGES->{exp} = new DC::UI::ExperienceProgress
2298 padding_x => 6,
2299 padding_y => 3,
2300 tooltip => "This progress bar shows your overall experience and your progress towards the next character level.",
2301 template => " Exp: 888,888,888,888 (lvl 188) ",
2302 );
2303
2304 $MENUBAR->add ($PICKUP_ENABLE = new DC::UI::CheckBox # checkbox bad, button better?
2305 tooltip => "Automatic Pickup Enable - when this checkbox is enabled, then your character "
2306 . "will automatically pick up items as defined by your item pickup settings "
2307 . "in the playerbook. Often (e.g. in apartments) you want to temporarily "
2308 . "disable autopickup by disabling this checkbox.",
2309 state => $CFG->{pickup} & PICKUP_INHIBIT ? 0 : 1,
2310 on_changed => sub {
2311 my ($self, $value) = @_;
2312 $CFG->{pickup} &= ~PICKUP_INHIBIT;
2313 $CFG->{pickup} |= PICKUP_INHIBIT unless $_[1];
2314 $CONN->send_pickup ($CFG->{pickup})
2315 if $CONN;
2316 },
2317 );
2318
2319 $MENUBAR->add ($GAUGES->{skillexp} = new DC::UI::ExperienceProgress
2320 c_rescale => 1,
2321 padding_x => 6,
2322 padding_y => 3,
2323 force_w => $::WIDTH * 0.2,
2324 tooltip => "This progress bar shows the currently used skill and your progress towards the next skill level of that skill.",
2325 template => "two handed weapons 99%",
2326 );
2327
2328 $MENUBAR->add ($GAUGES->{range} = new DC::UI::Label
2329 expand => 1,
2330 align => 1, can_hover => 1, can_events => 1,
2331 text => "Range and Combat Slots",
2332 tooltip => "#stat_ranged",
2333 );
2334
2335 $MENUFRAME->show;
2336}
2337
2338sub open_string_query {
2339 my ($title, $cb, $txt, $tooltip) = @_;
2340 my $dialog = new DC::UI::Toplevel
2341 x => "center",
2342 y => "center",
2343 z => 50,
2344 force_w => $WIDTH * 4/5,
2345 title => $title;
2346
2347 $dialog->add (
2348 my $e = new DC::UI::Entry
2349 on_activate => sub { $cb->(@_); $dialog->hide; 0 },
2350 on_key_down => sub { $_[1]->{sym} == 27 and $dialog->hide; 0 },
2351 tooltip => $tooltip
2352 );
2353
2354 $e->grab_focus;
2355 $e->set_text ($txt) if $txt;
2356 $dialog->show;
2357}
2358
2218sub show_tip_of_the_day { 2359sub show_tip_of_the_day {
2219 # find all tips 2360 # find all tips
2220 my @tod = DC::Pod::find tip_of_the_day => "*"; 2361 my @tod = DC::Pod::find tip_of_the_day => "*";
2221 2362
2222 DC::DB::get state => "tip_of_the_day", sub { 2363 DC::DB::get state => "tip_of_the_day", sub {
… …
2361 2502
2362 (new DC::UI::Frame 2503 (new DC::UI::Frame
2363 bg => [0, 0, 0, 0.4], 2504 bg => [0, 0, 0, 0.4],
2364 force_x => 0, 2505 force_x => 0,
2365 force_y => "max", 2506 force_y => "max",
2366 child => (my $LR = new DC::UI::VBox), 2507 child => (my $LL = new DC::UI::VBox),
2367 )->show; 2508 )->show;
2368 2509
2369 $LR->add ($STATUSBOX); 2510 $LL->add ($STATUSBOX);
2370 $LR->add ($MODBOX); 2511 $LL->add ($MODBOX);
2371 $LR->add (new DC::UI::Label 2512 $LL->add (new DC::UI::Label
2372 align => 0, 2513 align => 0,
2373 markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode", 2514 markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode",
2374 fontsize => 0.5, 2515 fontsize => 0.5,
2375 fg => [1, 1, 0, 0.7], 2516 fg => [1, 1, 0, 0.7],
2376 ); 2517 );
2377 2518
2378 DC::UI::Toplevel->new ( 2519 DC::UI::Toplevel->new (
2379 title => "Minimap", 2520 title => "Minimap",
2380 name => "mapmap", 2521 name => "mapmap",
2381 x => 0, 2522 x => 0,
2382 y => $FONTSIZE + 8, 2523 y => $::FONTSIZE + 8,#d# hack to move messages window below the menubar
2383 border_bg => [1, 1, 1, 192/255], 2524 border_bg => [1, 1, 1, 192/255],
2384 bg => [1, 1, 1, 0], 2525 bg => [1, 1, 1, 0],
2385 child => ($MAPMAP = new DC::MapWidget::MapMap 2526 child => ($MAPMAP = new DC::MapWidget::MapMap
2386 tooltip => "<b>Minimap</b>. This will display an overview of the surrounding areas.", 2527 tooltip => "<b>Minimap</b>. This will display an overview of the surrounding areas.",
2387 ), 2528 ),
… …
2416 $METASERVER = metaserver_dialog; 2557 $METASERVER = metaserver_dialog;
2417 # the name is changed to not conflict with the older name as users could have hidden it 2558 # the name is changed to not conflict with the older name as users could have hidden it
2418 $MESSAGE_WINDOW = new DC::UI::Dockbar 2559 $MESSAGE_WINDOW = new DC::UI::Dockbar
2419 name => "message_window2", 2560 name => "message_window2",
2420 title => 'Messages', 2561 title => 'Messages',
2562 y => $::FONTSIZE + 8,#d# hack to move messages window below the menubar
2421 force_w => $::WIDTH * 0.6, 2563 force_w => $::WIDTH * 0.6,
2422 force_h => $::HEIGHT * 0.25, 2564 force_h => $::HEIGHT * 0.25,
2423 ; 2565 ;
2424 2566
2425 $MESSAGE_DIST = new DC::MessageDistributor dockbar => $MESSAGE_WINDOW; 2567 $MESSAGE_DIST = new DC::MessageDistributor dockbar => $MESSAGE_WINDOW;
… …
2445 . "After pressing the combo the binding will be saved automatically and the " 2587 . "After pressing the combo the binding will be saved automatically and the "
2446 . "binding editor closes"); 2588 . "binding editor closes");
2447 $SETUP_NOTEBOOK->add_tab (Debug => debug_setup, 2589 $SETUP_NOTEBOOK->add_tab (Debug => debug_setup,
2448 "Some debuggin' options. Do not ask."); 2590 "Some debuggin' options. Do not ask.");
2449 2591
2450 $BUTTONBAR = new DC::UI::Buttonbar x => 0, y => 0, z => 200; # put on top 2592 make_help_window;
2593 make_menubar;
2451 2594
2452 $BUTTONBAR->add (new DC::UI::Flopper text => "Setup", other => $SETUP_DIALOG,
2453 tooltip => "Toggles a dialog where you can configure all aspects of this client.");
2454
2455# $BUTTONBAR->add (new DC::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW,
2456# tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
2457
2458 make_gauge_window->show; # XXX: this has to be set before make_stats_window as make_stats_window calls update_stats_window which updated the gauges also X-D
2459
2460 $BUTTONBAR->add (new DC::UI::Flopper text => "Playerbook", other => player_window,
2461 tooltip => "Toggles the player view, where you can manage Inventory, Spells, Skills and see your Stats.");
2462
2463 $BUTTONBAR->add (new DC::UI::Button
2464 text => "Save Config",
2465 tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
2466 on_activate => sub {
2467 $::CFG->{layout} = DC::UI::get_layout;
2468 DC::write_cfg;
2469 status "Configuration Saved";
2470 0
2471 },
2472 );
2473
2474 $BUTTONBAR->add (new DC::UI::Flopper text => "Help!", other => $HELP_WINDOW = help_window,
2475 tooltip => "View Documentation");
2476
2477 $BUTTONBAR->add (new DC::UI::Button
2478 text => "Quit",
2479 tooltip => "Terminates the program",
2480 on_activate => sub {
2481 if ($CONN) {
2482 open_quit_dialog;
2483 } else {
2484 EV::unloop EV::UNLOOP_ALL;
2485 }
2486 0
2487 },
2488 );
2489
2490 $BUTTONBAR->show;
2491 $SETUP_DIALOG->show; 2595 $SETUP_DIALOG->show;
2492 $MESSAGE_WINDOW->show; 2596 $MESSAGE_WINDOW->show;
2493 } 2597 }
2494 2598
2495 $MODE_SLIDER->set_range ([$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1, 1]); 2599 $MODE_SLIDER->set_range ([$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1, 1]);
2496 $MODE_SLIDER->emit (changed => $CFG->{sdl_mode}); 2600 $MODE_SLIDER->emit (changed => $CFG->{sdl_mode});
2497 2601
2498 $CAVEAT_LABEL->set_text ("None :)"); 2602 $CAVEAT_LABEL->set_text ("None :)");
2603 $CAVEAT_LABEL->set_text ("Apple/NVIDIA Texture bug (slow)")
2604 if $DC::OpenGL::APPLE_NVIDIA_BUG;
2499 $CAVEAT_LABEL->set_text ("Software Rendering (very slow)") 2605 $CAVEAT_LABEL->set_text ("Software Rendering (very slow)")
2500 unless DC::SDL_GL_GetAttribute DC::SDL_GL_ACCELERATED_VISUAL; 2606 unless DC::SDL_GL_GetAttribute DC::SDL_GL_ACCELERATED_VISUAL;
2501 2607
2502 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]); 2608 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
2503} 2609}
… …
2531my $want_refresh = EV::prepare_ns \&force_refresh; 2637my $want_refresh = EV::prepare_ns \&force_refresh;
2532 2638
2533my $input = EV::periodic 0, 1 / $MAX_FPS, undef, sub { 2639my $input = EV::periodic 0, 1 / $MAX_FPS, undef, sub {
2534 $NOW = EV::now; 2640 $NOW = EV::now;
2535 2641
2536 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_) 2642 ($SDL_CB[$_->{type}] || sub { warn "unhandled event $_->{type}" })->($_)
2537 for DC::poll_events; 2643 for DC::poll_events;
2538 2644
2539 if (%animate_object) { 2645 if (%animate_object) {
2540 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object; 2646 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
2541 $WANT_REFRESH = 1; 2647 $WANT_REFRESH = 1;
… …
2553sub animation_stop { 2659sub animation_stop {
2554 my ($widget) = @_; 2660 my ($widget) = @_;
2555 delete $animate_object{$widget}; 2661 delete $animate_object{$widget};
2556} 2662}
2557 2663
2558%SDL_CB = (
2559 DC::SDL_QUIT => sub { 2664$SDL_CB[DC::SDL_QUIT] = sub {
2560 crash "SDL_QUIT"; 2665 crash "SDL_QUIT";
2561 EV::unloop EV::UNLOOP_ALL; 2666 EV::unloop EV::UNLOOP_ALL;
2562 }, 2667};
2563 DC::SDL_VIDEORESIZE => sub { 2668$SDL_CB[DC::SDL_VIDEORESIZE] = sub { };
2564 },
2565 DC::SDL_VIDEOEXPOSE => sub { 2669$SDL_CB[DC::SDL_VIDEOEXPOSE] = sub {
2566 DC::UI::full_refresh; 2670 DC::UI::full_refresh;
2567 }, 2671};
2568 DC::SDL_ACTIVEEVENT => sub { 2672$SDL_CB[DC::SDL_ACTIVEEVENT] = sub {
2569# not useful, as APPACTIVE includes only iconified state, not unmapped 2673# not useful, as APPACTIVE includes only iconified state, not unmapped
2570# printf "active %x %x %x\n", $_[0]{gain}, $_[0]{state}, DC::SDL_GetAppState;#d# 2674# printf "active %x %x %x\n", $_[0]{gain}, $_[0]{state}, DC::SDL_GetAppState;#d#
2571# printf "a %x\n", DC::SDL_GetAppState & DC::SDL_APPACTIVE;#d# 2675# printf "a %x\n", DC::SDL_GetAppState & DC::SDL_APPACTIVE;#d#
2572# printf "A\n" if $_[0]{state} & DC::SDL_APPACTIVE; 2676# printf "A\n" if $_[0]{state} & DC::SDL_APPACTIVE;
2573# printf "K\n" if $_[0]{state} & DC::SDL_APPINPUTFOCUS; 2677# printf "K\n" if $_[0]{state} & DC::SDL_APPINPUTFOCUS;
2574# printf "M\n" if $_[0]{state} & DC::SDL_APPMOUSEFOCUS; 2678# printf "M\n" if $_[0]{state} & DC::SDL_APPMOUSEFOCUS;
2575 }, 2679};
2576 DC::SDL_KEYDOWN => sub { 2680$SDL_CB[DC::SDL_KEYDOWN] = sub {
2577 if ($_[0]{mod} & DC::KMOD_ALT && $_[0]{sym} == 13) { 2681 if ($_[0]{mod} & DC::KMOD_ALT && $_[0]{sym} == 13) {
2578 # alt-enter 2682 # alt-enter
2579 video_shutdown; 2683 video_shutdown;
2580 $FULLSCREEN_ENABLE->toggle; 2684 $FULLSCREEN_ENABLE->toggle;
2581 video_init; 2685 video_init;
2582 } else { 2686 } else {
2583 &DC::UI::feed_sdl_key_down_event; 2687 &DC::UI::feed_sdl_key_down_event;
2584 } 2688 }
2585 update_modbox; 2689 update_modbox;
2586 }, 2690};
2587 DC::SDL_KEYUP => sub { 2691$SDL_CB[DC::SDL_KEYUP] = sub {
2588 &DC::UI::feed_sdl_key_up_event; 2692 &DC::UI::feed_sdl_key_up_event;
2589 update_modbox; 2693 update_modbox;
2590 }, 2694};
2591 DC::SDL_MOUSEMOTION => \&DC::UI::feed_sdl_motion_event, 2695$SDL_CB[DC::SDL_MOUSEMOTION] = \&DC::UI::feed_sdl_motion_event,
2592 DC::SDL_MOUSEBUTTONDOWN => \&DC::UI::feed_sdl_button_down_event, 2696$SDL_CB[DC::SDL_MOUSEBUTTONDOWN] = \&DC::UI::feed_sdl_button_down_event,
2593 DC::SDL_MOUSEBUTTONUP => \&DC::UI::feed_sdl_button_up_event, 2697$SDL_CB[DC::SDL_MOUSEBUTTONUP] = \&DC::UI::feed_sdl_button_up_event,
2594 DC::SDL_USEREVENT => sub { 2698$SDL_CB[DC::SDL_USEREVENT] = sub {
2595 if ($_[0]{code} == 1) { 2699 if ($_[0]{code} == 1) {
2596 audio_channel_finished $_[0]{data1}; 2700 audio_channel_finished $_[0]{data1};
2597 } elsif ($_[0]{code} == 0) { 2701 } elsif ($_[0]{code} == 0) {
2598 audio_music_finished; 2702 audio_music_finished;
2599 }
2600 }, 2703 }
2601); 2704};
2602 2705
2603############################################################################# 2706#############################################################################
2604 2707
2605$SIG{INT} = $SIG{TERM} = sub { 2708$SIG{INT} = $SIG{TERM} = sub {
2606 EV::unloop; 2709 EV::unloop;
2607 #d# TODO calling exit here hangs the process in some futex 2710 #d# TODO calling exit here hangs the process in some futex
2608}; 2711};
2609 2712
2610# due to mac os x + sdl combined briandamage, we need this contortion 2713# due to mac os x + sdl combined braindamage, we need this contortion
2611sub main { 2714sub main {
2612 { 2715 {
2613 DC::Pod::load_docwiki DC::find_rcfile "docwiki.pst"; 2716 DC::Pod::load_docwiki DC::find_rcfile "docwiki.pst";
2614 2717
2615 if (-e "$Deliantra::VARDIR/client.cf") { 2718 if (-e "$Deliantra::VARDIR/client.cf") {
… …
2632 DC::DB::open_db; 2735 DC::DB::open_db;
2633 2736
2634 DC::UI::set_layout ($::CFG->{layout}); 2737 DC::UI::set_layout ($::CFG->{layout});
2635 2738
2636 my %DEF_CFG = ( 2739 my %DEF_CFG = (
2740 config_autosave => 1,
2637 sdl_mode => undef, 2741 sdl_mode => undef,
2638 fullscreen => 1, 2742 fullscreen => 1,
2639 fast => 0, 2743 fast => 0,
2640 force_opengl11 => undef, 2744 force_opengl11 => undef,
2641 disable_alpha => 0, 2745 disable_alpha => 0,
2642 smooth_movement => 1, 2746 smooth_movement => 1,
2747 smooth_transitions => 1,
2643 texture_compression => 1, 2748 texture_compression => 1,
2644 map_scale => 1, 2749 map_scale => 1,
2645 fow_enable => 1, 2750 fow_enable => 1,
2646 fow_intensity => 0, 2751 fow_intensity => 0,
2752 fow_texture => 0,
2647 map_smoothing => 1, 2753 map_smoothing => 1,
2648 gui_fontsize => 1, 2754 gui_fontsize => 1,
2649 log_fontsize => 0.7, 2755 log_fontsize => 0.7,
2650 gauge_fontsize => 1, 2756 gauge_fontsize => 1,
2651 gauge_size => 0.35, 2757 gauge_size => 0.35,
… …
2659 effects_enable => 1, 2765 effects_enable => 1,
2660 effects_volume => 1, 2766 effects_volume => 1,
2661 bgm_enable => 1, 2767 bgm_enable => 1,
2662 bgm_volume => 0.5, 2768 bgm_volume => 0.5,
2663 output_rate => "", 2769 output_rate => "",
2664 pickup => 0, 2770 pickup => PICKUP_SPELLBOOK | PICKUP_SKILLSCROLL | PICKUP_VALUABLES,
2665 inv_sort => "mtime", 2771 inv_sort => "mtime",
2666 default => "profile", # default profile 2772 default => "profile", # default profile
2667 show_tips => 1, 2773 show_tips => 1,
2668 logview_max_par => 1000, 2774 logview_max_par => 1000,
2669 shift_fire_stop => 0, 2775 shift_fire_stop => 0,
2670 uitheme => "wood", 2776 uitheme => "wood",
2671 ); 2777 map_shift_x => -24, # arbitrary
2778 map_shift_y => +24, # arbitrary
2672 2779 );
2780
2673 while (my ($k, $v) = each %DEF_CFG) { 2781 while (my ($k, $v) = each %DEF_CFG) {
2674 $CFG->{$k} = $v unless exists $CFG->{$k}; 2782 $CFG->{$k} = $v unless exists $CFG->{$k};
2675 } 2783 }
2676 2784
2677 $CFG->{profile}{default}{host} ||= "gameserver.deliantra.net"; 2785 my @args = @ARGV;
2786
2787 my $profile = 'default';
2788
2789 for (my $i = 0; $i < @args; $i++) {
2790 if ($args[$i] =~ /^--?profile$/) {
2791 $profile = $args[$i + 1];
2792 splice @args, $i, 2, ();
2793 $i = 0;
2794 } elsif ($args[$i] =~ /^--?h/) {
2795 print STDERR "Usage: $0 [--profile name] [host [user [password]]]\n";
2796 exit 0;
2797 }
2798 }
2799
2800 $CFG->{profile}{$profile} ||= {};
2678 $PROFILE = $CFG->{profile}{default}; 2801 $PROFILE = $CFG->{profile}{$profile};
2802 $PROFILE->{host} ||= "gameserver.deliantra.net";
2803
2804 $PROFILE->{host} = $args[0] if @args > 0;
2805 $PROFILE->{user} = $args[1] if @args > 1;
2806 $PROFILE->{password} = $args[2] if @args > 2;
2679 2807
2680 # convert old bindings (only default profile matters) 2808 # convert old bindings (only default profile matters)
2681 if (my $bindings = delete $PROFILE->{bindings}) { 2809 if (my $bindings = delete $PROFILE->{bindings}) {
2682 while (my ($mod, $syms) = each %$bindings) { 2810 while (my ($mod, $syms) = each %$bindings) {
2683 while (my ($sym, $cmds) = each %$syms) { 2811 while (my ($sym, $cmds) = each %$syms) {
… …
2689 } 2817 }
2690 } 2818 }
2691 2819
2692 sdl_init; 2820 sdl_init;
2693 2821
2822 $ENV{FONTCONFIG_FILE} = DC::find_rcfile "fonts/fonts.conf";
2823 $ENV{FONTCONFIG_DIR} = DC::find_rcfile "fonts";
2824
2694 { 2825 {
2695 my @fonts = map DC::find_rcfile "fonts/$_", qw( 2826 my @fonts = map DC::find_rcfile "fonts/$_", qw(
2696 DejaVuSans.ttf 2827 DejaVuSans.ttf
2697 DejaVuSansMono.ttf 2828 DejaVuSansMono.ttf
2698 DejaVuSans-Bold.ttf 2829 DejaVuSans-Bold.ttf
2699 DejaVuSansMono-Bold.ttf 2830 DejaVuSansMono-Bold.ttf
2700 DejaVuSans-Oblique.ttf 2831 DejaVuSans-Oblique.ttf
2701 DejaVuSansMono-Oblique.ttf 2832 DejaVuSansMono-Oblique.ttf
2702 DejaVuSans-BoldOblique.ttf 2833 DejaVuSans-BoldOblique.ttf
2703 DejaVuSansMono-BoldOblique.ttf 2834 DejaVuSansMono-BoldOblique.ttf
2835 mona.ttf
2704 ); 2836 );
2705 2837
2706 DC::add_font $_ for @fonts; 2838 DC::add_font $_ for @fonts;
2707 2839
2708 $FONT_PROP = new_from_file DC::Font $fonts[0]; 2840 $FONT_PROP = new_from_file DC::Font $fonts[0];
2709 $FONT_FIXED = new_from_file DC::Font $fonts[1]; 2841 $FONT_FIXED = new_from_file DC::Font $fonts[1];
2710 2842
2711 $FONT_PROP->make_default; 2843 $FONT_PROP->make_default;
2712 2844
… …
2738 }; 2870 };
2739 2871
2740 delete $SIG{__DIE__}; 2872 delete $SIG{__DIE__};
2741 EV::loop; 2873 EV::loop;
2742 2874
2875 DC::write_cfg if $CFG->{config_autosave};
2876
2743#video_shutdown; 2877 #video_shutdown;
2744#audio_shutdown; 2878 #audio_shutdown;
2879
2745 DC::OpenGL::quit; 2880 DC::OpenGL::quit;
2746 DC::SDL_Quit; 2881 DC::SDL_Quit;
2747 DC::DB::Server::stop; 2882 DC::DB::Server::stop;
2748} 2883}
2749 2884
… …
2753 2888
2754deliantra - A Deliantra MORPG game client 2889deliantra - A Deliantra MORPG game client
2755 2890
2756=head1 SYNOPSIS 2891=head1 SYNOPSIS
2757 2892
2758Just run it - no commandline arguments are supported. 2893 deliantra [--profile name] [host [user [password]]]
2894 deliantra --help
2759 2895
2760=head1 USAGE 2896=head1 USAGE
2761 2897
2762deliantra utilises OpenGL for all UI elements and the game. It is supposed to 2898The deliantra client utilises OpenGL for all UI elements and the game. It
2763be used in fullscreen mode and interactively. 2899is supposed to be used in fullscreen mode and interactively.
2764 2900
2765=head1 DEBUGGING 2901=head1 DEBUGGING
2766
2767 2902
2768CFPLUS_DEBUG - environment variable 2903CFPLUS_DEBUG - environment variable
2769 2904
2770 1 draw borders around widgets 2905 1 draw borders around widgets
2771 2 add low-level widget info to tooltips 2906 2 add low-level widget info to tooltips

Diff Legend

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