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.17 by root, Wed Dec 26 20:46:39 2007 UTC vs.
Revision 1.85 by root, Sun Jan 11 03:19:47 2009 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 {
50 } 55 }
51 56
52 if ($^O eq "MSWin32") { 57 if ($^O eq "MSWin32") {
53 # pango is relocatable on win32 58 # pango is relocatable on win32
54 } else { 59 } else {
55 open my $fh, "<:perlio", "$root/pangoversion" 60 # OS X
56 or die "pangoversion: $!"; 61 $ENV{FONTCONFIG_FILE} = "$root/fonts.conf"; # no effect??!?!
57 my $PANGO = <$fh>; 62 $ENV{FONTCONFIG_DIR} = $root; # no effect??!?!
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"; 63 $ENV{PANGO_RC_FILE} = "$root/pango.rc";
71 open my $fh, ">:perlio", $ENV{PANGO_RC_FILE} 64 $ENV{DYLD_LIBRARY_PATH} = $root;
72 or die "$ENV{PANGO_RC_FILE}: $!"; 65 chdir $root; # for pango modules, maybe other things
73 print $fh "[Pango]\nModuleFiles = $root/pango-modules\n";
74 } 66 }
75 67
76 unshift @INC, $root; 68 unshift @INC, $root;
77 } 69 }
78} 70}
79 71
80# prepend private library directory 72# prepend private library directory
81BEGIN { 73BEGIN {
82 for (grep !ref, @INC) { 74 for (grep !ref, @INC) {
83 my $path = "$_/Deliantra/Client/private/dc"; 75 my $path = "$_/Deliantra/Client/private";
84 if (-d $path) { 76 if (-d $path) {
85 unshift @INC, $path; 77 unshift @INC, $path;
86 last; 78 last;
87 } 79 }
88 } 80 }
90 82
91# need to do it again because that pile of garbage called PAR nukes it before main 83# need to do it again because that pile of garbage called PAR nukes it before main
92unshift @INC, $ENV{PAR_TEMP} 84unshift @INC, $ENV{PAR_TEMP}
93 if %PAR::LibCache; 85 if %PAR::LibCache;
94 86
95use Time::HiRes 'time';
96use EV; 87use EV;
88BEGIN { *time = \&EV::time }
89
97use List::Util qw(max min); 90use List::Util qw(max min);
98 91
99use Deliantra; 92use Deliantra;
100use Deliantra::Protocol::Constants; 93use Deliantra::Protocol::Constants;
101 94
95use AnyEvent::Util ();
96use AnyEvent::Socket ();
97use AnyEvent::DNS ();
98
102use Compress::LZF; 99use Compress::LZF;
100use JSON::XS;
103 101
104use dc; 102use DC;
103
104sub crash($;$) {
105 # nop during compiletime
106}
107
108BEGIN {
109 $SIG{__DIE__} = sub {
110 return if $^S;
111 crash "CRASH/DIE: $_[0]" => 1;
112 DC::fatal Carp::longmess "$_[0]";
113 }
114}
115
105use dc::OpenGL (); 116use DC::OpenGL ();
106use dc::Protocol; 117use DC::Protocol;
107use dc::DB; 118use DC::DB;
108use dc::UI; 119use DC::UI;
109use dc::UI::Canvas; 120use DC::UI::Canvas;
110use dc::UI::Inventory; 121use DC::UI::Inventory;
111use dc::UI::SpellList; 122use DC::UI::SpellList;
112use dc::UI::Dockable; 123use DC::UI::Dockable;
113use dc::UI::MessageWindow; 124use DC::UI::Dockbar;
114use dc::UI::ChatView; 125use DC::UI::ChatView;
126use DC::MessageDistributor;
115use dc::Pod; 127use DC::Pod;
116use dc::MapWidget; 128use DC::MapWidget;
117use dc::Macro; 129use DC::Macro;
118 130
119$SIG{QUIT} = sub { Carp::cluck "QUIT" }; 131$SIG{QUIT} = sub { Carp::cluck "QUIT" };
120$SIG{PIPE} = 'IGNORE'; 132$SIG{PIPE} = 'IGNORE';
121 133
122$EV::DIED = sub { 134$EV::DIED = sub {
135 crash "CRASH/EV::DIED: $@" => 0;
123 dc::fatal Carp::longmess $@; 136 DC::fatal Carp::longmess $@;
124}; 137};
125 138
126my $MAX_FPS = 60; 139my $MAX_FPS = 60;
127my $MIN_FPS = 5; # unused as of yet
128 140
129our $META_SERVER = "http://metaserver.schmorp.de/current.json"; 141our $META_SERVER = "http://metaserver.schmorp.de/current.json";
130 142
131our $LAST_REFRESH; 143our $LAST_REFRESH;
132our $NOW; 144our $NOW;
133 145
134our $CFG; 146our $CFG;
135our $CONN;
136our $PROFILE; # current profile 147our $PROFILE; # current profile
137our $FAST; # fast, low-quality mode, possibly useful for software-rendering 148our $FAST; # fast, low-quality mode, possibly useful for software-rendering
138 149
139our $WANT_REFRESH; 150our $WANT_REFRESH;
140 151
152our $MODE_SLIDER;
153our $CAVEAT_LABEL;
154
141our @SDL_MODES; 155our @SDL_MODES;
156our $SDL_REINIT = 1;
142our $WIDTH; 157our $WIDTH;
143our $HEIGHT; 158our $HEIGHT;
144our $FULLSCREEN; 159our $FULLSCREEN;
145our $FONTSIZE; 160our $FONTSIZE;
146 161
147our $FONT_PROP; 162our $FONT_PROP;
148our $FONT_FIXED; 163our $FONT_FIXED;
149 164
165our $CONN;
166
150our $MAP; 167our $MAP;
151our $MAPMAP; 168our $MAPMAP;
152our $MAPWIDGET; 169our $MAPWIDGET;
153our $COMPLETER; 170our $COMPLETER;
154our $BUTTONBAR; 171our $MENUFRAME; # the rectangle at the top
172our $MENUBAR; # the hbox at the top
173our $MENUPOPUP;
174our $BUTTONBAR; # the menu buttons
155our $METASERVER; 175our $METASERVER;
156our $LOGIN_BUTTON; 176our $LOGIN_BUTTON;
157our $QUIT_DIALOG; 177our $QUIT_DIALOG;
158our $HOST_ENTRY; 178our $HOST_ENTRY;
159our $FULLSCREEN_ENABLE; 179our $FULLSCREEN_ENABLE;
179our $SPELL_PAGE; 199our $SPELL_PAGE;
180our $SPELL_LIST; 200our $SPELL_LIST;
181 201
182our $HELP_WINDOW; 202our $HELP_WINDOW;
183our $MESSAGE_WINDOW; 203our $MESSAGE_WINDOW;
204our $MESSAGE_DIST;
184our $FLOORBOX; 205our $FLOORBOX;
185our $GAUGES; 206our $GAUGES;
186our $STATWIDS; 207our $STATWIDS;
187 208
188our $SDL_ACTIVE; 209our $SDL_ACTIVE;
189our %SDL_CB; 210our %SDL_CB;
190 211
191our $ALT_ENTER_MESSAGE; 212our $ALT_ENTER_MESSAGE;
192our $STATUSBOX; 213our $STATUSBOX;
214our $MODBOX;
193our $DEBUG_STATUS; 215our $DEBUG_STATUS;
194 216
195our $INV; 217our $INV;
196our $INVR; 218our $INVR;
197our $INVR_HB; 219our $INVR_HB;
198 220
199############################################################################# 221#############################################################################
200 222
223# write a crash message blockingly to the socket, if possible
224# this is a bit too complicated for my tastes, but it was easy.
225*crash = sub($;$) {
226 my ($msg, $backtrace) = @_;
227
228 warn $msg;
229
230 return unless $CONN;
231
232 my $fh = $CONN->{fh}
233 or return;
234
235 my $buf = delete $CONN->{wbuf};
236
237 $buf .= pack "n/a*", "exti " . JSON::XS::encode_json [clientlog => undef, substr $msg, 0, 8000];
238
239 AnyEvent::Util::fh_nonblocking $fh, 0;
240 syswrite $fh, $buf;
241 AnyEvent::Util::fh_nonblocking $fh, 1;
242
243 $msg =~ s/\s+$//;
244
245 # backtrace as second step, in case it crashes, too
246 crash Carp::longmess "$msg\nbacktrace, for client version $DC::VERSION, generated"
247 if $backtrace;
248};
249
250sub clienterror($;$) {
251 my ($msg, $backtrace) = @_;
252
253 warn $msg;
254
255 return unless $CONN;
256
257 $CONN->send_exti_msg (clientlog => $msg);
258 $CONN->send_exti_msg (clientlog => Carp::longmess "$msg\nbacktrace, for client version $DC::VERSION, generated") if $backtrace;
259}
260
261#############################################################################
262
201sub status { 263sub status {
202 $STATUSBOX->add (dc::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]); 264 $STATUSBOX->add (DC::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
203} 265}
204 266
205sub debug { 267sub debug {
206 $DEBUG_STATUS->set_text ($_[0]); 268 $DEBUG_STATUS->set_text ($_[0]);
207} 269}
208 270
209sub message { 271sub message {
210 $MESSAGE_WINDOW->message (@_); 272 $MESSAGE_DIST->message (@_);
273}
274
275sub update_modbox {
276 my $mod = DC::SDL_GetModState;
277
278 my $markup;
279
280 $markup .= $mod & DC::KMOD_CTRL
281 ? ($MAPWIDGET->{ctrl} ? "[REPEAT]" : "[<span foreground='#888'>REPEAT</span>]")
282 : "[<span foreground='#888'> once </span>]";
283
284 $markup .= $mod & DC::KMOD_SHIFT
285 ? ($MAPWIDGET->{shft} ? "[FIRE]" : "[<span foreground='#888'>FIRE</span>]")
286 : "[<span foreground='#888'>move</span>]";
287
288 $markup .= $mod & (DC::KMOD_ALT | DC::KMOD_META)
289 ? "[ALT]"
290 : "[<span foreground='#888'>alt</span>]";
291
292 $markup .= $mod & DC::KMOD_NUM
293 ? "[NUM]"
294 : "[<span foreground='#888'>num</span>]";
295
296 # <tt> around next statement works around some bug that keeps the
297 # "font =>" from being used on windows
298 $MODBOX->set_markup ("<tt>$markup</tt>");
211} 299}
212 300
213############################################################################# 301#############################################################################
214#TODO: maybe move into own audio module... 302#TODO: maybe move into own audio module...
215 303
245 333
246 if (my $chunk = $AUDIO_CHUNK{$face}) { 334 if (my $chunk = $AUDIO_CHUNK{$face}) {
247 for (grep $_->[0] >= EV::now, @{(delete $AUDIO_PLAY{$face}) || []}) { 335 for (grep $_->[0] >= EV::now, @{(delete $AUDIO_PLAY{$face}) || []}) {
248 my (undef, $dx, $dy, $vol) = @$_; 336 my (undef, $dx, $dy, $vol) = @$_;
249 337
250 my $channel = dc::Channel::find; 338 my $channel = DC::Channel::find;
251 $channel->volume ($vol * $CFG->{effects_volume} * 128 / 255); 339 $channel->volume ($vol * $CFG->{effects_volume} * 128 / 255);
252 $channel->set_position_r ($dx, $dy, 20); 340 $channel->set_position_r ($dx, $dy, 20);
253 $chunk->play ($channel); 341 $chunk->play ($channel);
254 } 342 }
255 } else { 343 } else {
258 or return; 346 or return;
259 347
260 $meta->{data} 348 $meta->{data}
261 or return; 349 or return;
262 350
263 # if its a jingle, play it as ambient music 351 # if it's a jingle, play it as ambient music
264 if ($meta->{data}{jingle}) { 352 if ($meta->{data}{jingle}) {
265 if (delete $AUDIO_PLAY{$face}) { # take the jingle out of the sound queue 353 if (delete $AUDIO_PLAY{$face}) { # take the jingle out of the sound queue
266 push @MUSIC_JINGLE, $meta; # push it oto the music/jingle queue 354 push @MUSIC_JINGLE, $meta; # push it unto the music/jingle queue
267 &audio_music_push ($face); 355 &audio_music_push ($face);
268 } 356 }
269 } else { 357 } else {
270 # fetch from database 358 # fetch from database
271 dc::DB::get res_data => $meta->{name}, sub { 359 DC::DB::get res_data => $meta->{name}, sub {
272 my $rwops = new dc::RW $_[0]; 360 my $rwops = new DC::RW $_[0];
273 my $chunk = new dc::MixChunk $rwops 361 my $chunk = new DC::MixChunk $rwops
274 or Carp::confess "sound face " . (JSON::XS::encode_json $meta) . " unloadable: " . dc::Mix_GetError; 362 or Carp::confess "sound face " . (JSON::XS::encode_json $meta) . " (" . (unpack "H64", $_[0]) . ") unloadable: " . DC::Mix_GetError;
275 $chunk->volume (($meta->{data}{volume} || 1) * 128); 363 $chunk->volume (($meta->{data}{volume} || 1) * 128);
276 $AUDIO_CHUNK{$face} = $chunk; 364 $AUDIO_CHUNK{$face} = $chunk;
277 365
278 audio_sound_push ($face); 366 audio_sound_push ($face);
279 }; 367 };
298sub audio_music_set_meta { 386sub audio_music_set_meta {
299 my ($meta) = @_; 387 my ($meta) = @_;
300 388
301 $MUSIC_PLAYING_META = $meta; 389 $MUSIC_PLAYING_META = $meta;
302 $MUSIC_PLAYING_WIDGET->set_markup ( 390 $MUSIC_PLAYING_WIDGET->set_markup (
303 "<b>Name</b>: " . (dc::asxml $meta->{data}{name}) . "\n" 391 "<b>Name</b>: " . (DC::asxml $meta->{data}{name}) . "\n"
304 . "<b>Author</b>: " . (dc::asxml $meta->{data}{author}) . "\n" 392 . "<b>Author</b>: " . (DC::asxml $meta->{data}{author}) . "\n"
305 . "<b>Source</b>: " . (dc::asxml $meta->{data}{source}) . "\n" 393 . "<b>Source</b>: " . (DC::asxml $meta->{data}{source}) . "\n"
306 . "<b>License</b>: " . (dc::asxml $meta->{data}{license}) 394 . "<b>License</b>: " . (DC::asxml $meta->{data}{license})
307 ); 395 );
308} 396}
309 397
310sub audio_music_update_volume { 398sub audio_music_update_volume {
311 return unless $MUSIC_PLAYING_META; 399 return unless $MUSIC_PLAYING_META;
312 my $volume = $MUSIC_PLAYING_META->{data}{volume} || 1; 400 my $volume = $MUSIC_PLAYING_META->{data}{volume} || 1;
313 my $base = $MUSIC_PLAYING_META->{data}{jingle} ? 1 : $CFG->{bgm_volume}; 401 my $base = $MUSIC_PLAYING_META->{data}{jingle} ? 1 : $CFG->{bgm_volume};
314 dc::MixMusic::volume $base * $volume * 128; 402 DC::MixMusic::volume $base * $volume * 128;
315} 403}
316 404
317sub audio_music_start { 405sub audio_music_start {
318 my $meta = $MUSIC_PLAYING_META; 406 my $meta = $MUSIC_PLAYING_META;
319 407
320 dc::DB::get res_data => $meta->{name}, sub { 408 DC::DB::get res_data => $meta->{name}, sub {
321 return unless $SDL_MIXER; 409 return unless $SDL_MIXER;
322 410
323 # music might have changed... 411 # music might have changed...
324 $meta eq $MUSIC_PLAYING_META 412 $meta eq $MUSIC_PLAYING_META
325 or return &audio_music_start (); 413 or return &audio_music_start ();
326 414
327 audio_music_update_volume; 415 audio_music_update_volume;
328 416
329 $MUSIC_PLAYING_DATA = \$_[0]; 417 $MUSIC_PLAYING_DATA = \$_[0];
330 418
419 $meta->{path} or length $_[0]
420 or return clienterror "empty music face from res_data ($meta->{face})";#d#
421
331 my $rwops = $meta->{path} 422 my $rwops = $meta->{path}
332 ? new_from_file dc::RW $meta->{path} 423 ? (new_from_file DC::RW $meta->{path} or return clienterror "unable to load music face $meta->{path}: $!")#d#clienterror
333 : new dc::RW $$MUSIC_PLAYING_DATA; 424 : new DC::RW $$MUSIC_PLAYING_DATA;
334 425
335 $MUSIC_PLAYER = new dc::MixMusic $rwops 426 $MUSIC_PLAYER = new DC::MixMusic $rwops
336 or Carp::confess "music face $meta->{face} unloadable: " . dc::Mix_GetError; 427 or return clienterror "music face $meta->{face} unloadable: " . DC::Mix_GetError => 1;
337 428
338 my $NOW = time; 429 my $NOW = time;
339 430
340 if ($MUSIC_PLAYING_META->{stop_time} > $NOW - $MUSIC_RESUME) { 431 if ($MUSIC_PLAYING_META->{stop_time} > $NOW - $MUSIC_RESUME) {
341 my $pos = $MUSIC_PLAYING_META->{stop_pos}; 432 my $pos = $MUSIC_PLAYING_META->{stop_pos};
372 463
373 # randomize music a bit so that the order is not always the same 464 # randomize music a bit so that the order is not always the same
374 $_->{stop_time} ||= rand for @MUSIC_HAVE; 465 $_->{stop_time} ||= rand for @MUSIC_HAVE;
375 466
376 # default MUSIC_HAVE == MUSIC_DEFAULT 467 # default MUSIC_HAVE == MUSIC_DEFAULT
377 @MUSIC_HAVE = { path => dc::find_rcfile "music/$MUSIC_DEFAULT" } 468 @MUSIC_HAVE = { path => DC::find_rcfile "music/$MUSIC_DEFAULT" }
378 unless @MUSIC_HAVE; 469 unless @MUSIC_HAVE;
379 } 470 }
380 471
381 # if the currently playing song is acceptable, let it continue 472 # if the currently playing song is acceptable, let it continue
382 return if grep $MUSIC_PLAYING_META == $_, @MUSIC_HAVE; 473 return if grep $MUSIC_PLAYING_META == $_, @MUSIC_HAVE;
384 my $NOW = time; 475 my $NOW = time;
385 476
386 if ($MUSIC_PLAYING_META) { 477 if ($MUSIC_PLAYING_META) {
387 $MUSIC_PLAYING_META->{stop_time} = $NOW; 478 $MUSIC_PLAYING_META->{stop_time} = $NOW;
388 $MUSIC_PLAYING_META->{stop_pos} = $NOW - $MUSIC_START; 479 $MUSIC_PLAYING_META->{stop_pos} = $NOW - $MUSIC_START;
389 dc::MixMusic::fade_out $fade_out; 480 DC::MixMusic::fade_out $fade_out;
390 } else { 481 } else {
391 # sort by stop time, oldest first 482 # sort by stop time, oldest first
392 @MUSIC_HAVE = sort { $a->{stop_time} <=> $b->{stop_time} } @MUSIC_HAVE; 483 @MUSIC_HAVE = sort { $a->{stop_time} <=> $b->{stop_time} } @MUSIC_HAVE;
393 484
394 # if the most recently-played piece played very recently, 485 # if the most recently-played piece played very recently,
428} 519}
429 520
430sub audio_init { 521sub audio_init {
431 if ($CFG->{audio_enable}) { 522 if ($CFG->{audio_enable}) {
432 $ENV{MIX_EFFECTSMAXSPEED} = 1; 523 $ENV{MIX_EFFECTSMAXSPEED} = 1;
433 $SDL_MIXER = !dc::Mix_OpenAudio 524 $SDL_MIXER = !DC::Mix_OpenAudio
434 $CFG->{audio_hw_frequency}, 525 $CFG->{audio_hw_frequency},
435 dc::MIX_DEFAULT_FORMAT, 526 DC::MIX_DEFAULT_FORMAT,
436 $CFG->{audio_hw_channels}, 527 $CFG->{audio_hw_channels},
437 $CFG->{audio_hw_chunksize}; 528 $CFG->{audio_hw_chunksize};
438 529
439 if ($SDL_MIXER) { 530 if ($SDL_MIXER) {
440 dc::Mix_AllocateChannels $CFG->{audio_mix_channels}; 531 DC::Mix_AllocateChannels $CFG->{audio_mix_channels};
441 532
442 audio_music_finished; 533 audio_music_finished;
443 } else { 534 } else {
444 status "Unable to open sound device: there will be no sound"; 535 status "Unable to open sound device: there will be no sound";
445 } 536 }
459 $MUSIC_WANT = []; 550 $MUSIC_WANT = [];
460 @MUSIC_JINGLE = (); 551 @MUSIC_JINGLE = ();
461 %AUDIO_PLAY = (); 552 %AUDIO_PLAY = ();
462 %AUDIO_CHUNK = (); 553 %AUDIO_CHUNK = ();
463 554
464 dc::Mix_CloseAudio if $SDL_MIXER; 555 DC::Mix_CloseAudio if $SDL_MIXER;
465 undef $SDL_MIXER; 556 undef $SDL_MIXER;
466} 557}
467 558
468############################################################################# 559#############################################################################
469 560
489 580
490 return; 581 return;
491 } 582 }
492 } 583 }
493 584
494 $conn->{query_dialog} = my $dialog = new dc::UI::Toplevel 585 $conn->{query_dialog} = my $dialog = new DC::UI::Toplevel
495 x => "center", 586 x => "center",
496 y => "center", 587 y => "center",
497 title => "Server Query", 588 title => "Server Query",
498 child => my $vbox = new dc::UI::VBox, 589 child => my $vbox = new DC::UI::VBox,
499 ; 590 ;
500 591
501 my @dialog = my $label = new dc::UI::Label 592 my @dialog = my $label = new DC::UI::Label
502 max_w => $::WIDTH * 0.8, 593 max_w => $::WIDTH * 0.8,
503 ellipsise => 0, 594 ellipsise => 0,
504 text => $prompt; 595 text => $prompt;
505 596
506 if ($flags & CS_QUERY_YESNO) { 597 if ($flags & CS_QUERY_YESNO) {
507 push @dialog, my $hbox = new dc::UI::HBox; 598 push @dialog, my $hbox = new DC::UI::HBox;
508 599
509 $hbox->add (new dc::UI::Button 600 $hbox->add (new DC::UI::Button
510 text => "No", 601 text => "No",
511 on_activate => sub { 602 on_activate => sub {
512 $conn->send ("reply n"); 603 $conn->send ("reply n");
513 $dialog->destroy; 604 $dialog->destroy;
514 0 605 0
515 } 606 }
516 ); 607 );
517 $hbox->add (new dc::UI::Button 608 $hbox->add (new DC::UI::Button
518 text => "Yes", 609 text => "Yes",
519 on_activate => sub { 610 on_activate => sub {
520 $conn->send ("reply y"); 611 $conn->send ("reply y");
521 destroy_query_dialog $conn; 612 destroy_query_dialog $conn;
522 0 613 0
527 618
528 } elsif ($flags & CS_QUERY_SINGLECHAR) { 619 } elsif ($flags & CS_QUERY_SINGLECHAR) {
529 if ($prompt =~ /Now choose a character|Press any key for the next race/i) { 620 if ($prompt =~ /Now choose a character|Press any key for the next race/i) {
530 $dialog->{tooltip} = "#charcreation_focus"; 621 $dialog->{tooltip} = "#charcreation_focus";
531 622
532 unshift @dialog, new dc::UI::Label 623 unshift @dialog, new DC::UI::Label
533 max_w => $::WIDTH * 0.8, 624 max_w => $::WIDTH * 0.8,
534 ellipsise => 0, 625 ellipsise => 0,
535 markup => "\nOr use your keyboard and the text entry below:\n"; 626 markup => "\nOr use your keyboard and the text entry below:\n";
536 627
537 unshift @dialog, my $table = new dc::UI::Table; 628 unshift @dialog, my $table = new DC::UI::Table;
538 629
539 $table->add_at (0, 0, new dc::UI::Button 630 $table->add_at (0, 0, new DC::UI::Button
540 text => "Next Race", 631 text => "Next Race",
541 on_activate => sub { 632 on_activate => sub {
542 $conn->send ("reply n"); 633 $conn->send ("reply n");
543 destroy_query_dialog $conn; 634 destroy_query_dialog $conn;
544 0 635 0
545 }, 636 },
546 ); 637 );
547 $table->add_at (2, 0, new dc::UI::Button 638 $table->add_at (2, 0, new DC::UI::Button
548 text => "Accept", 639 text => "Accept",
549 on_activate => sub { 640 on_activate => sub {
550 $conn->send ("reply d"); 641 $conn->send ("reply d");
551 destroy_query_dialog $conn; 642 destroy_query_dialog $conn;
552 0 643 0
553 }, 644 },
554 ); 645 );
555 646
556 if ($conn->{chargen_race_description}) { 647 if ($conn->{chargen_race_description}) {
557 unshift @dialog, new dc::UI::Label 648 unshift @dialog, new DC::UI::Label
558 max_w => $::WIDTH * 0.8, 649 max_w => $::WIDTH * 0.8,
559 ellipsise => 0, 650 ellipsise => 0,
560 markup => "<span foreground='#ccccff'>$conn->{chargen_race_description}</span>", 651 markup => "<span foreground='#ccccff'>$conn->{chargen_race_description}</span>",
561 ; 652 ;
562 } 653 }
563 654
564 unshift @dialog, new dc::UI::Face 655 unshift @dialog, new DC::UI::Face
565 face => $conn->{player}{face}, 656 face => $conn->{player}{face},
566 bg => [.2, .2, .2, 1], 657 bg => [.2, .2, .2, 1],
567 min_w => 64, 658 min_w => 64,
568 min_h => 64, 659 min_h => 64,
569 ; 660 ;
570 661
571 if ($conn->{chargen_race_title}) { 662 if ($conn->{chargen_race_title}) {
572 unshift @dialog, new dc::UI::Label 663 unshift @dialog, new DC::UI::Label
573 allign => 1, 664 allign => 1,
574 ellipsise => 0, 665 ellipsise => 0,
575 markup => "<span foreground='#ccccff' size='large'>Race: $conn->{chargen_race_title}</span>", 666 markup => "<span foreground='#ccccff' size='large'>Race: $conn->{chargen_race_title}</span>",
576 ; 667 ;
577 } 668 }
578 669
579 unshift @dialog, new dc::UI::Label 670 unshift @dialog, new DC::UI::Label
580 max_w => $::WIDTH * 0.4, 671 max_w => $::WIDTH * 0.4,
581 ellipsise => 0, 672 ellipsise => 0,
582 markup => (dc::Pod::section_label ui => "chargen_race"), 673 markup => (DC::Pod::section_label ui => "chargen_race"),
583 ; 674 ;
584 675
585 } elsif ($prompt =~ /roll new stats/) { 676 } elsif ($prompt =~ /roll new stats/) {
586 if (my $stat = delete $conn->{stat_change_with}) { 677 if (my $stat = delete $conn->{stat_change_with}) {
587 $conn->send ("reply $stat"); 678 $conn->send ("reply $stat");
588 destroy_query_dialog $conn; 679 destroy_query_dialog $conn;
589 return; 680 return;
590 } 681 }
591 682
592 unshift @dialog, new dc::UI::Label 683 unshift @dialog, new DC::UI::Label
593 max_w => $::WIDTH * 0.4, 684 max_w => $::WIDTH * 0.4,
594 ellipsise => 0, 685 ellipsise => 0,
595 markup => "\nOr use your keyboard and the text entry below:\n"; 686 markup => "\nOr use your keyboard and the text entry below:\n";
596 687
597 unshift @dialog, my $table = new dc::UI::Table; 688 unshift @dialog, my $table = new DC::UI::Table;
598 689
599 # left: re-roll 690 # left: re-roll
600 $table->add_at (0, 0, new dc::UI::Button 691 $table->add_at (0, 0, new DC::UI::Button
601 text => "Roll Again", 692 text => "Roll Again",
602 on_activate => sub { 693 on_activate => sub {
603 $conn->send ("reply y"); 694 $conn->send ("reply y");
604 destroy_query_dialog $conn; 695 destroy_query_dialog $conn;
605 0 696 0
606 }, 697 },
607 ); 698 );
608 699
609 # center: swap stats 700 # center: swap stats
610 my ($sw1, $sw2) = map +(new dc::UI::Selector 701 my ($sw1, $sw2) = map +(new DC::UI::Selector
611 expand => 1, 702 expand => 1,
612 value => $_, 703 value => $_,
613 options => [ 704 options => [
614 [1 => "Str", "Strength ($conn->{stat}{+CS_STAT_STR})"], 705 [1 => "Str", "Strength ($conn->{stat}{+CS_STAT_STR})"],
615 [2 => "Dex", "Dexterity ($conn->{stat}{+CS_STAT_DEX})"], 706 [2 => "Dex", "Dexterity ($conn->{stat}{+CS_STAT_DEX})"],
619 [6 => "Pow", "Power ($conn->{stat}{+CS_STAT_POW})"], 710 [6 => "Pow", "Power ($conn->{stat}{+CS_STAT_POW})"],
620 [7 => "Cha", "Charisma ($conn->{stat}{+CS_STAT_CHA})"], 711 [7 => "Cha", "Charisma ($conn->{stat}{+CS_STAT_CHA})"],
621 ], 712 ],
622 ), 1 .. 2; 713 ), 1 .. 2;
623 714
624 $table->add_at (2, 0, new dc::UI::Button 715 $table->add_at (2, 0, new DC::UI::Button
625 text => "Swap Stats", 716 text => "Swap Stats",
626 on_activate => sub { 717 on_activate => sub {
627 $conn->{stat_change_with} = $sw2->{value}; 718 $conn->{stat_change_with} = $sw2->{value};
628 $conn->send ("reply $sw1->{value}"); 719 $conn->send ("reply $sw1->{value}");
629 destroy_query_dialog $conn; 720 destroy_query_dialog $conn;
630 0 721 0
631 }, 722 },
632 ); 723 );
633 $table->add_at (2, 1, new dc::UI::HBox children => [$sw1, $sw2]); 724 $table->add_at (2, 1, new DC::UI::HBox children => [$sw1, $sw2]);
634 725
635 # right: accept 726 # right: accept
636 $table->add_at (4, 0, new dc::UI::Button 727 $table->add_at (4, 0, new DC::UI::Button
637 text => "Accept", 728 text => "Accept",
638 on_activate => sub { 729 on_activate => sub {
639 $conn->send ("reply n"); 730 $conn->send ("reply n");
640 $STATS_PAGE->hide;
641 destroy_query_dialog $conn; 731 destroy_query_dialog $conn;
642 0 732 0
643 }, 733 },
644 ); 734 );
645 735
646 unshift @dialog, my $hbox = new dc::UI::HBox; 736 unshift @dialog, my $hbox = new DC::UI::HBox;
647 for ( 737 for (
648 [Str => CS_STAT_STR], 738 [Str => CS_STAT_STR],
649 [Dex => CS_STAT_DEX], 739 [Dex => CS_STAT_DEX],
650 [Con => CS_STAT_CON], 740 [Con => CS_STAT_CON],
651 [Int => CS_STAT_INT], 741 [Int => CS_STAT_INT],
652 [Wis => CS_STAT_WIS], 742 [Wis => CS_STAT_WIS],
653 [Pow => CS_STAT_POW], 743 [Pow => CS_STAT_POW],
654 [Cha => CS_STAT_CHA], 744 [Cha => CS_STAT_CHA],
655 ) { 745 ) {
656 my ($name, $id) = @$_; 746 my ($name, $id) = @$_;
657 $hbox->add (new dc::UI::Label 747 $hbox->add (new DC::UI::Label
658 markup => "$conn->{stat}{$id} <span foreground='yellow'>$name</span>", 748 markup => "$conn->{stat}{$id} <span foreground='yellow'>$name</span>",
659 align => 0,
660 expand => 1, 749 expand => 1,
661 can_events => 1, 750 can_events => 1,
662 can_hover => 1, 751 can_hover => 1,
663 tooltip => "#stat_$name", 752 tooltip => "#stat_$name",
664 ); 753 );
665 } 754 }
666 755
667 unshift @dialog, new dc::UI::Label 756 unshift @dialog, new DC::UI::Label
668 max_w => $::WIDTH * 0.4, 757 max_w => $::WIDTH * 0.4,
669 ellipsise => 0, 758 ellipsise => 0,
670 markup => (dc::Pod::section_label ui => "chargen_stats"), 759 markup => (DC::Pod::section_label ui => "chargen_stats"),
671 ; 760 ;
672 } 761 }
673 762
674 push @dialog, my $entry = new dc::UI::Entry 763 push @dialog, my $entry = new DC::UI::Entry
675 on_changed => sub { 764 on_changed => sub {
676 $conn->send ("reply $_[1]"); 765 $conn->send ("reply $_[1]");
677 destroy_query_dialog $conn; 766 destroy_query_dialog $conn;
678 0 767 0
679 }, 768 },
682 $entry->grab_focus; 771 $entry->grab_focus;
683 772
684 } else { 773 } else {
685 $dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)"; 774 $dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
686 775
687 push @dialog, my $entry = new dc::UI::Entry 776 push @dialog, my $entry = new DC::UI::Entry
688 $flags & CS_QUERY_HIDEINPUT ? (hidden => "*") : (), 777 $flags & CS_QUERY_HIDEINPUT ? (hidden => "*") : (),
689 on_activate => sub { 778 on_activate => sub {
690 $conn->send ("reply $_[1]"); 779 $conn->send ("reply $_[1]");
691 destroy_query_dialog $conn; 780 destroy_query_dialog $conn;
692 0 781 0
698 787
699 $vbox->add (@dialog); 788 $vbox->add (@dialog);
700 $dialog->show; 789 $dialog->show;
701} 790}
702 791
703sub start_game { 792sub dc_connect {
704 status "logging in..."; 793 my ($host, $port) = @_;
705 794
706 $LOGIN_BUTTON->set_text ("Logout");
707 $SETUP_DIALOG->hide;
708
709 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32; 795 my $mapw = List::Util::min 48, List::Util::max 11, int 1.5 + $WIDTH * $CFG->{mapsize} * 0.01 / 32;
796 my $maph = List::Util::min 48, List::Util::max 11, int 1.5 + $HEIGHT * $CFG->{mapsize} * 0.01 / 32;
710 797
711 my ($host, $port) = split /:/, $PROFILE->{host};
712
713 $MAP = new dc::Map;
714
715 $CONN = eval { 798 $CONN =
716 new dc::Protocol 799 new DC::Protocol
717 host => $host, 800 host => $host,
718 port => $port || 13327, 801 port => $port,
719 user => $PROFILE->{user}, 802 user => $PROFILE->{user},
720 pass => $PROFILE->{password}, 803 pass => $PROFILE->{password},
721 mapw => $mapsize, 804 mapw => $mapw,
722 maph => $mapsize, 805 maph => $maph,
723 806
724 client => "cfplus $dc::VERSION $] $^O", 807 client => "$DC::VERSION $] $^O",
725 808
726 map_widget => $MAPWIDGET, 809 map_widget => $MAPWIDGET,
727 statusbox => $STATUSBOX, 810 statusbox => $STATUSBOX,
728 map => $MAP, 811 map => $MAP,
729 mapmap => $MAPMAP, 812 mapmap => $MAPMAP,
730 query => \&server_query, 813 query => \&server_query,
731 814
732 setup_req => { 815 setup_req => {
733 smoothing => $CFG->{map_smoothing}*1, 816 smoothing => $CFG->{map_smoothing}*1,
734 }, 817 },
818
819 on_connect => sub {
820 if ($_[0]) {
821 DC::lowdelay fileno $CONN->{fh};
822
823 status "login successful";
824 } else {
825 undef $CONN;
826 status "unable to connect: $!";
827 stop_game();
828 }
829 },
735 }; 830 ;
831}
736 832
737 if ($CONN) { 833sub start_game {
738 dc::lowdelay fileno $CONN->{fh}; 834 status "logging in...";
739 835
740 status "login successful"; 836 $LOGIN_BUTTON->set_text ("Logout");
837 $SETUP_DIALOG->hide;
838
839 my ($host, $port) = AnyEvent::Socket::parse_hostport $PROFILE->{host}, "deliantra=13327";
840
841 $MAP = new DC::Map;
842
843 # hack to make SURE we find the IP address all right
844 # can be removed once AnyEvent::DNS is proven stable.
845 if ($host eq "gameserver.deliantra.net") {
846 AnyEvent::DNS::a "dnstest.deliantra.net", sub {
847 if ($_[0] ne "80.101.114.108") { # Perl
848 status "dns failure, using hardcoded address";
849 $host = "129.13.162.95";
850 }
851
852 dc_connect $host, $port;
853 };
741 } else { 854 } else {
742 status "unable to connect"; 855 dc_connect $host, $port;
743 stop_game();
744 } 856 }
745} 857}
746 858
747sub stop_game { 859sub stop_game {
860 crash "stop_game";
861
748 $LOGIN_BUTTON->set_text ("Login / Register"); 862 $LOGIN_BUTTON->set_text ("Login / Register");
749 $SETUP_NOTEBOOK->set_current_page ($SETUP_LOGIN); 863 $SETUP_NOTEBOOK->set_current_page ($SETUP_LOGIN);
750 $SETUP_DIALOG->show; 864 $SETUP_DIALOG->show;
751 $PL_WINDOW->hide; 865 $PL_WINDOW->hide;
752 $SPELL_LIST->clear_spells; 866 $SPELL_LIST->clear_spells;
753 $dc::UI::ROOT->emit (stop_game => ! ! $CONN); 867 $DC::UI::ROOT->emit (stop_game => ! ! $CONN);
754 868
755 &audio_music_set_ambient ([]); 869 &audio_music_set_ambient ([]);
756 870
757 return unless $CONN; 871 return unless $CONN;
758 872
764 878
765 undef $MAP; 879 undef $MAP;
766} 880}
767 881
768sub graphics_setup { 882sub graphics_setup {
769 my $vbox = new dc::UI::VBox; 883 my $vbox = new DC::UI::VBox;
770 884
885 {
886 $vbox->add (my $frame = new DC::UI::FancyFrame expand => 1, label => "Video Mode");
887
771 $vbox->add (my $table = new dc::UI::Table expand => 1, col_expand => [0, 1]); 888 $frame->add (my $table = new DC::UI::Table expand => 1, col_expand => [0, 1]);
772 889
773 my $row = 0; 890 my $row = 0;
774 891
775 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "OpenGL Info"); 892 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "OpenGL Info");
776 $table->add_at (1, $row++, new dc::UI::Label valign => 0, fontsize => 0.8, text => dc::OpenGL::gl_vendor . ", " . dc::OpenGL::gl_version, 893 $table->add_at (1, $row++, new DC::UI::Label fontsize => 0.8, text => DC::OpenGL::gl_vendor . ", " . DC::OpenGL::gl_version,
777 can_events => 1, 894 can_events => 1,
778 tooltip => "<tt><span size='8192'>" . (dc::OpenGL::gl_extensions) . "</span></tt>"); 895 tooltip => "<tt><span size='8192'>" . (DC::OpenGL::gl_extensions) . "</span></tt>");
779 896
897 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Caveats");
898 $table->add_at (1, $row++, $CAVEAT_LABEL = new DC::UI::Label fontsize => 0.8,
899 can_events => 1,
900 tooltip => "This field shows any known issues with your config or driver, such as "
901 . "a non-accelerated display format. You can try to work around these issues "
902 . "by selecting a different video mode, changing the settings below or "
903 . "by installing the right driver for your graphics card.");
904
905 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "UI Theme");
906 $table->add_at (1, $row++, $FULLSCREEN_ENABLE = new DC::UI::Selector
907 value => $CFG->{uitheme},
908 options => [
909 [wood => "Wood (the default)"],
910 [plain => "Plain (very)"],
911 [blue => "Blue (dark)"],
912 [metal => "Metal (light)"],
913 ],
914 tooltip => "Choose the User Interface theme that you like most :)",
915 on_changed => sub { my ($self, $value) = @_; $CFG->{uitheme} = $value; 0 }
916 );
917
780 my $vidmode_tooltip = 918 my $vidmode_tooltip =
781 "<b>Video Mode.</b> The video mode to use for fullscreen (and the window size for windowed operation). " 919 "<b>Video Mode.</b> The video mode to use for fullscreen (and the window size for windowed operation). "
782 . "The format is <i>width</i> x <i>height</i> \@ <i>depth-per-channel</i> + <i>alpha-channel</i>."; 920 . "The format is <i>width</i> x <i>height</i> \@ <i>depth-per-channel</i> + <i>alpha-channel</i>.";
783 921
784 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Video Mode"); 922 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Video Mode");
785 $table->add_at (1, $row++, my $hbox = new dc::UI::HBox); 923 $table->add_at (1, $row++, my $hbox = new DC::UI::HBox);
786 924
787 $hbox->add (my $mode_slider = new dc::UI::Slider 925 $hbox->add ($MODE_SLIDER = new DC::UI::Slider
788 force_w => $WIDTH * 0.1, expand => 1, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1], 926 c_rescale => 1,
927 force_w => $WIDTH * 0.1, expand => 1,
928 range => [ ($CFG->{sdl_mode}) x 3 ],
789 tooltip => $vidmode_tooltip); 929 tooltip => $vidmode_tooltip);
790 $hbox->add (my $mode_label = new dc::UI::Label 930 $hbox->add (my $mode_label = new DC::UI::Label
791 align => 0, valign => 0, height => 0.8, template => "9999x9999@9+9", 931 height => 0.8, template => "9999x9999@9+9",
792 can_events => 1, tooltip => $vidmode_tooltip); 932 can_events => 1, tooltip => $vidmode_tooltip);
793 933
794 $mode_slider->connect (changed => sub { 934 $MODE_SLIDER->connect (changed => sub {
795 my ($self, $value) = @_; 935 my ($self, $value) = @_;
796 936
797 $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value; 937 $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
798 $mode_label->set_text (sprintf '%dx%d@%d+%d', @{$SDL_MODES[$value]}); 938 $mode_label->set_text (sprintf '%dx%d@%d+%d', @{$SDL_MODES[$value]});
799 }); 939 });
800 $mode_slider->emit (changed => $mode_slider->{range}[0]); 940 $MODE_SLIDER->emit (changed => $MODE_SLIDER->{range}[0]);
801 941
802 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Fullscreen"); 942 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Fullscreen");
803 $table->add_at (1, $row++, $FULLSCREEN_ENABLE = new dc::UI::CheckBox 943 $table->add_at (1, $row++, $FULLSCREEN_ENABLE = new DC::UI::CheckBox
804 state => $CFG->{fullscreen}, 944 state => $CFG->{fullscreen},
805 tooltip => "Bring the client into fullscreen mode.", 945 tooltip => "Bring the client into fullscreen mode.",
806 on_changed => sub { my ($self, $value) = @_; $CFG->{fullscreen} = $value; 0 } 946 on_changed => sub { my ($self, $value) = @_; $CFG->{fullscreen} = $value; 0 }
807 ); 947 );
808 948
809 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Force OpenGL 1.1"); 949 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Force OpenGL 1.1");
810 $table->add_at (1, $row++, new dc::UI::CheckBox 950 $table->add_at (1, $row++, new DC::UI::CheckBox
811 state => $CFG->{force_opengl11}, 951 state => $CFG->{force_opengl11},
812 tooltip => "Limit CFPlus to use OpenGL 1.1 features only. This will normally result in " 952 tooltip => "Limit Deliantra to use OpenGL 1.1 features only. This will normally result in "
813 . "higher memory usage and slower performance. It will, however, help tremendously on " 953 . "higher memory usage and slower performance. It will, however, help tremendously on "
814 . "cards that claim to support a feature but fall back to software rendering. " 954 . "cards that claim to support a feature but fall back to software rendering. "
815 . "Nvidia Geforce FX cards are known to claim features the hardware doesn't support, " 955 . "Nvidia Geforce FX cards are known to claim features the hardware doesn't support, "
816 . "but cards and drivers from other vendors (ATI) are often just as bad. <b>If you " 956 . "but cards and drivers from other vendors (ATI) are often just as bad. "
817 . "experience extremely low framerates and your card should do better, try this option.</b>", 957 . "<b>If you experience extremely low framerates and your card should do better, try this option.</b>",
818 on_changed => sub { my ($self, $value) = @_; $CFG->{force_opengl11} = $value; 0 } 958 on_changed => sub { my ($self, $value) = @_; $CFG->{force_opengl11} = $value; 0 }
819 ); 959 );
820 960
821 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Compress Textures"); 961 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Forbid Alpha");
822 $table->add_at (1, $row++, new dc::UI::CheckBox 962 $table->add_at (1, $row++, new DC::UI::CheckBox
963 state => $CFG->{disable_alpha},
964 tooltip => "Forbid the use of the alpha channel. This makes Deliantra look a lot worse "
965 . "by disabling a number of textures and transparency effects. Normally, these "
966 . "effects do not cost a lot of resources, but some graphics cards might fall "
967 . "back to extremely slow rendering if this is enabled. If disabling this option "
968 . "noticably improves the framerate of the client please report this! "
969 . "<b>If you experience extremely low framerates and your card should do better, try this option.</b>",
970 on_changed => sub {
971 my ($self, $value) = @_;
972 $CFG->{disable_alpha} = $value;
973 $SDL_REINIT = 1; # SDL_SetVideoMode ignores GL attr changes
974 0
975 }
976 );
977
978 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Compress Textures");
979 $table->add_at (1, $row++, new DC::UI::CheckBox
823 state => $CFG->{texture_compression}, 980 state => $CFG->{texture_compression},
824 tooltip => "Use texture compression. Normally this will not reduce visual quality noticable but " 981 tooltip => "Use texture compression. Normally this will not reduce visual quality noticable but "
825 . "will save a lot of memory and increase performance. The compression algorithm " 982 . "will save a lot of memory and increase performance (and also fall prey to the ever-buggy Mac OS X software renderer). "
826 . "can differ form card to card, so your mileage may vary. This setting is ignored in " 983 . "The compression algorithm can differ form card to card, so your mileage may vary. This setting is ignored in "
827 . "forced OpenGL 1.1 mode.", 984 . "forced OpenGL 1.1 mode and when using the Apple renderer.",
828 on_changed => sub { my ($self, $value) = @_; $CFG->{texture_compression} = $value; 0 } 985 on_changed => sub { my ($self, $value) = @_; $CFG->{texture_compression} = $value; 0 }
829 ); 986 );
830 987
831 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Fast & Ugly"); 988 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Fast & Ugly");
832 $table->add_at (1, $row++, new dc::UI::CheckBox 989 $table->add_at (1, $row++, new DC::UI::CheckBox
833 state => $CFG->{fast}, 990 state => $CFG->{fast},
834 tooltip => "Lower the visual quality considerably to speed up rendering.", 991 tooltip => "Lower the visual quality considerably to speed up rendering.",
835 on_changed => sub { my ($self, $value) = @_; $CFG->{fast} = $value; 0 } 992 on_changed => sub { my ($self, $value) = @_; $CFG->{fast} = $value; 0 }
836 ); 993 );
837 994
838 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "GUI Fontsize"); 995 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "GUI Fontsize");
839 $table->add_at (1, $row++, new dc::UI::Slider 996 $table->add_at (1, $row++, new DC::UI::Slider
840 range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1], 997 range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],
841 tooltip => "The base font size used by most GUI elements that do not have their own setting.", 998 tooltip => "The base font size used by most GUI elements that do not have their own setting.",
842 on_changed => sub { $CFG->{gui_fontsize} = $_[1]; 0 }, 999 on_changed => sub { $CFG->{gui_fontsize} = $_[1]; 0 },
843 ); 1000 );
844 1001
845 $table->add_at (1, $row++, new dc::UI::Button 1002 $table->add_at (1, $row++, new DC::UI::Button
846 expand => 1, align => 0, text => "Apply", 1003 expand => 1, text => "Apply",
847 tooltip => "Apply the video settings above.", 1004 tooltip => "Apply the video settings above.",
848 on_activate => sub { 1005 on_activate => sub {
849 video_shutdown (); 1006 video_shutdown ();
850 video_init (); 1007 video_init ();
1008 0
851 0 1009 }
852 } 1010 );
1011 }
1012
1013 {
1014 $vbox->add (my $frame = new DC::UI::FancyFrame expand => 1, label => "Other Settings");
1015
1016 $frame->add (my $table = new DC::UI::Table expand => 1, col_expand => [0, 1]);
1017
1018 my $row = 0;
1019 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Smooth Movement");
1020 $table->add_at (1, $row++, new DC::UI::CheckBox
1021 state => $CFG->{smooth_movement},
1022 tooltip => "<b>Smooth Movement</b> tries to make movement, well, smoother, but also increases the framerate. "
1023 . "If you have a very slow system, non-accelerated drivers or plain dislike smooth scrolling, "
1024 . "then disable this option. Changes take effect immdiately.",
1025 on_changed => sub { my ($self, $value) = @_; $CFG->{smooth_movement} = $value; 0 }
853 ); 1026 );
854 1027
855 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Map Scale"); 1028 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Map Scale");
856 $table->add_at (1, $row++, new dc::UI::Slider 1029 $table->add_at (1, $row++, new DC::UI::Slider
857 range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1], 1030 range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
858 tooltip => "Enlarge or shrink the displayed map. Changes are instant.", 1031 tooltip => "Enlarge or shrink the displayed map. Changes are instant.",
859 on_changed => sub { my ($self, $value) = @_; $CFG->{map_scale} = 2 ** $value; 0 } 1032 on_changed => sub { my ($self, $value) = @_; $CFG->{map_scale} = 2 ** $value; 0 }
860 ); 1033 );
861 1034
862 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Map Smoothing"); 1035 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Map Smoothing");
863 $table->add_at (1, $row++, new dc::UI::CheckBox 1036 $table->add_at (1, $row++, new DC::UI::CheckBox
864 state => $CFG->{map_smoothing}, 1037 state => $CFG->{map_smoothing},
865 tooltip => "<b>Map Smoothing</b> tries to make tile borders less square. " 1038 tooltip => "<b>Map Smoothing</b> tries to make tile borders less square. "
866 . "This increases load on the graphics subsystem and works only with TRT servers. " 1039 . "This increases load on the graphics subsystem and works only with TRT servers. "
867 . "Changes take effect at next login only.", 1040 . "Changes take effect at next login only.",
868 on_changed => sub { my ($self, $value) = @_; $CFG->{map_smoothing} = $value; 0 } 1041 on_changed => sub { my ($self, $value) = @_; $CFG->{map_smoothing} = $value; 0 }
869 ); 1042 );
870 1043
871 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Fog of War"); 1044 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Fog of War");
872 $table->add_at (1, $row++, new dc::UI::CheckBox 1045 $table->add_at (1, $row++, new DC::UI::CheckBox
873 state => $CFG->{fow_enable}, 1046 state => $CFG->{fow_enable},
874 tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.", 1047 tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",
875 on_changed => sub { my ($self, $value) = @_; $CFG->{fow_enable} = $value; 0 } 1048 on_changed => sub { my ($self, $value) = @_; $CFG->{fow_enable} = $value; 0 }
876 ); 1049 );
877 1050
878 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "FoW Intensity"); 1051 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "FoW Intensity");
879 $table->add_at (1, $row++, new dc::UI::Slider 1052 $table->add_at (1, $row++, new DC::UI::Slider
880 range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256], 1053 range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],
881 tooltip => "<b>Fog of War Lightness.</b> The higher the intensity, the lighter the Fog-of-War color. Changes are instant.", 1054 tooltip => "<b>Fog of War Lightness.</b> The higher the intensity, the lighter the Fog-of-War color. Changes are instant.",
882 on_changed => sub { my ($self, $value) = @_; $CFG->{fow_intensity} = $value; 0 } 1055 on_changed => sub { my ($self, $value) = @_; $CFG->{fow_intensity} = $value; 0 }
883 ); 1056 );
884 1057
885 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Message Fontsize"); 1058 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Message Fontsize");
886 $table->add_at (1, $row++, new dc::UI::Slider 1059 $table->add_at (1, $row++, new DC::UI::Slider
887 range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1], 1060 range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],
888 tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant, " 1061 tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant, "
889 . "but you still need to press apply to correctly re-layout the widget.", 1062 . "but you still need to press apply to correctly re-layout the widget.",
890 on_changed => sub { $MESSAGE_WINDOW->set_fontsize ($CFG->{log_fontsize} = $_[1]); 0 }, 1063 on_changed => sub { $MESSAGE_DIST->set_fontsize ($CFG->{log_fontsize} = $_[1]); 0 },
891 ); 1064 );
892 1065
893 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Gauge fontsize"); 1066 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Gauge fontsize");
894 $table->add_at (1, $row++, new dc::UI::Slider 1067 $table->add_at (1, $row++, new DC::UI::Slider
895 range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1], 1068 range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],
896 tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.", 1069 tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.",
897 on_changed => sub { 1070 on_changed => sub {
898 $CFG->{gauge_fontsize} = $_[1]; 1071 $CFG->{gauge_fontsize} = $_[1];
899 &set_gauge_window_fontsize; 1072 &set_gauge_window_fontsize;
1073 0
900 0 1074 }
901 } 1075 );
902 );
903 1076
904 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Gauge size"); 1077 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Gauge size");
905 $table->add_at (1, $row++, new dc::UI::Slider 1078 $table->add_at (1, $row++, new DC::UI::Slider
906 range => [$CFG->{gauge_size}, 0.2, 0.8], 1079 range => [$CFG->{gauge_size}, 0.2, 0.8],
907 tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.", 1080 tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",
908 on_changed => sub { 1081 on_changed => sub {
909 $CFG->{gauge_size} = $_[1]; 1082 $CFG->{gauge_size} = $_[1];
910 $GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size}); 1083 $GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
1084 0
911 0 1085 }
912 } 1086 );
913 ); 1087 }
914 1088
915 $vbox 1089 $vbox
916} 1090}
917 1091
918our $AUDIO_HW_CHUNKSIZE; 1092our $AUDIO_HW_CHUNKSIZE;
919our $AUDIO_INFO; 1093our $AUDIO_INFO;
920 1094
921sub audio_tab_update { 1095sub audio_tab_update {
922 my ($freq, $format, $chans) = dc::Mix_QuerySpec; 1096 my ($freq, $format, $chans) = DC::Mix_QuerySpec;
923 1097
924 $AUDIO_HW_CHUNKSIZE->set_options ([ 1098 $AUDIO_HW_CHUNKSIZE->set_options ([
925 [0, "default", "Use System Default"], 1099 [0, "default", "Use System Default"],
926 map { 1100 map {
927 my $ms = sprintf "%dms", 1000 * $_ / ($CFG->{audio_hw_frequency} || 22050); 1101 my $ms = sprintf "%dms", 1000 * $_ / ($CFG->{audio_hw_frequency} || 22050);
937 1111
938 $AUDIO_INFO->set_text ($text); 1112 $AUDIO_INFO->set_text ($text);
939} 1113}
940 1114
941sub audio_setup { 1115sub audio_setup {
942 my $vbox = new dc::UI::VBox; 1116 my $vbox = new DC::UI::VBox;
943 1117
944 $vbox->add (my $table = new dc::UI::Table expand => 1, col_expand => [0, 0, 1]); 1118 $vbox->add (my $table = new DC::UI::Table expand => 1, col_expand => [0, 0, 1]);
945 1119
946 my $row = 0; 1120 my $row = 0;
947 1121
948 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Audio Enable"); 1122 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Audio Enable");
949 $table->add_at (1, $row++, new dc::UI::CheckBox 1123 $table->add_at (1, $row++, new DC::UI::CheckBox
950 state => $CFG->{audio_enable}, 1124 state => $CFG->{audio_enable},
951 tooltip => "<b>Master Audio Enable.</b> If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.", 1125 tooltip => "<b>Master Audio Enable.</b> If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.",
952 on_changed => sub { $CFG->{audio_enable} = $_[1]; 1 } 1126 on_changed => sub { $CFG->{audio_enable} = $_[1]; 1 }
953 ); 1127 );
954 1128
955 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Sound Effects"); 1129 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Sound Effects");
956 $table->add_at (1, $row, new dc::UI::CheckBox 1130 $table->add_at (1, $row, new DC::UI::CheckBox
957 expand => 1, state => $CFG->{effects_enable}, 1131 expand => 1, state => $CFG->{effects_enable},
958 tooltip => "If enabled, sound effects are enabled. If disabled, no sound effects will be played.", 1132 tooltip => "If enabled, sound effects are enabled. If disabled, no sound effects will be played.",
959 on_changed => sub { 1133 on_changed => sub {
960 $CFG->{effects_enable} = $_[1]; 1134 $CFG->{effects_enable} = $_[1];
961 $CONN->update_fx_want if $CONN; 1135 $CONN->update_fx_want if $CONN;
962 1 1136 1
963 } 1137 }
964 ); 1138 );
965 $table->add_at (2, $row++, new dc::UI::Slider 1139 $table->add_at (2, $row++, new DC::UI::Slider
966 expand => 1, range => [$CFG->{effects_volume}, 0, 1, 0, 1/128], 1140 expand => 1, range => [$CFG->{effects_volume}, 0, 1, 0, 1/128],
967 tooltip => "The relative volume of sound effects. Best audio quality is achieved if this " 1141 tooltip => "The relative volume of sound effects. Best audio quality is achieved if this "
968 . "is set highest (rightmost) and you use your operating system volume setting. Changes are instant.", 1142 . "is set highest (rightmost) and you use your operating system volume setting. Changes are instant.",
969 on_changed => sub { $CFG->{effects_volume} = $_[1]; 1 } 1143 on_changed => sub { $CFG->{effects_volume} = $_[1]; 1 }
970 ); 1144 );
971 1145
972 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Background Music"); 1146 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Background Music");
973 $table->add_at (1, $row, new dc::UI::CheckBox 1147 $table->add_at (1, $row, new DC::UI::CheckBox
974 expand => 1, state => $CFG->{bgm_enable}, 1148 expand => 1, state => $CFG->{bgm_enable},
975 tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.", 1149 tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",
976 on_changed => sub { 1150 on_changed => sub {
977 $CFG->{bgm_enable} = $_[1]; 1151 $CFG->{bgm_enable} = $_[1];
978 $CONN->update_fx_want if $CONN; 1152 $CONN->update_fx_want if $CONN;
979 audio_music_push; 1153 audio_music_push;
980 1 1154 1
981 } 1155 }
982 ); 1156 );
983 $table->add_at (2, $row++, new dc::UI::Slider 1157 $table->add_at (2, $row++, new DC::UI::Slider
984 expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128], 1158 expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],
985 tooltip => "The volume of the background music. Changes are instant.", 1159 tooltip => "The volume of the background music. Changes are instant.",
986 on_changed => sub { $CFG->{bgm_volume} = $_[1]; audio_music_update_volume; 0 } 1160 on_changed => sub { $CFG->{bgm_volume} = $_[1]; audio_music_update_volume; 0 }
987 ); 1161 );
988 1162
989 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Frequency"); 1163 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Frequency");
990 $table->add_at (1, $row++, new dc::UI::Selector 1164 $table->add_at (1, $row++, new DC::UI::Selector
991 c_colspan => 2, expand => 1, 1165 c_colspan => 2, expand => 1,
992 value => $CFG->{audio_hw_frequency}, 1166 value => $CFG->{audio_hw_frequency},
993 options => [ 1167 options => [
994 [ 0, "default" , "Use System Default"], 1168 [ 0, "default" , "Use System Default"],
995 [11025, "11 kHz" , "11kHz (low quality)"], 1169 [11025, "11 kHz" , "11kHz (low quality)"],
1003 audio_tab_update; 1177 audio_tab_update;
1004 1 1178 1
1005 } 1179 }
1006 ); 1180 );
1007 1181
1008 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Channels"); 1182 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Channels");
1009 $table->add_at (1, $row++, new dc::UI::Selector 1183 $table->add_at (1, $row++, new DC::UI::Selector
1010 c_colspan => 2, expand => 1, 1184 c_colspan => 2, expand => 1,
1011 value => $CFG->{audio_hw_channels}, 1185 value => $CFG->{audio_hw_channels},
1012 options => [ 1186 options => [
1013 [0, "default" , "Use System Default"], 1187 [0, "default" , "Use System Default"],
1014 [1, "Mono" , "Mono (single channel, low quality)"], 1188 [1, "Mono" , "Mono (single channel, low quality)"],
1022 audio_tab_update; 1196 audio_tab_update;
1023 1 1197 1
1024 } 1198 }
1025 ); 1199 );
1026 1200
1027 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Latency"); 1201 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Latency");
1028 $table->add_at (1, $row++, $AUDIO_HW_CHUNKSIZE = new dc::UI::Selector 1202 $table->add_at (1, $row++, $AUDIO_HW_CHUNKSIZE = new DC::UI::Selector
1029 c_colspan => 2, expand => 1, 1203 c_colspan => 2, expand => 1,
1030 value => $CFG->{audio_hw_chunksize}, 1204 value => $CFG->{audio_hw_chunksize},
1031 tooltip => "The guarenteed latency. Lower is better, but also more cpu-intensive and might cause stuttering. If music playback " 1205 tooltip => "The guarenteed latency. Lower is better, but also more cpu-intensive and might cause stuttering. If music playback "
1032 . "is stuttering, increase this value. Values of 50-100ms are optimal.", 1206 . "is stuttering, increase this value. Values of 50-100ms are optimal.",
1033 on_changed => sub { 1207 on_changed => sub {
1036 1 1210 1
1037 } 1211 }
1038 ); 1212 );
1039 1213
1040 # should really be a slider 1214 # should really be a slider
1041 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Mixer Voices"); 1215 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Mixer Voices");
1042 $table->add_at (1, $row++, new dc::UI::ValSlider 1216 $table->add_at (1, $row++, new DC::UI::ValSlider
1043 c_colspan => 2, expand => 1, 1217 c_colspan => 2, expand => 1,
1044 tooltip => "The number of simultaneous sound effects possible. Higher is better, but also more cpu-intensive and might cause stuttering.", 1218 tooltip => "The number of simultaneous sound effects possible. Higher is better, but also more cpu-intensive and might cause stuttering.",
1045 range => [$::CFG->{audio_mix_channels}, 4, 32, 0, 1], 1219 range => [$::CFG->{audio_mix_channels}, 4, 32, 0, 1],
1046 template => ">= 99", 1220 template => ">= 99",
1047 on_changed => sub { 1221 on_changed => sub {
1051 if $value; 1225 if $value;
1052 1; 1226 1;
1053 } 1227 }
1054 ); 1228 );
1055 1229
1056 $table->add_at (1, $row++, new dc::UI::Button 1230 $table->add_at (1, $row++, new DC::UI::Button
1057 c_colspan => 2, expand => 1, align => 0, text => "Apply", 1231 c_colspan => 2, expand => 1, text => "Apply",
1058 tooltip => "Apply the audio settings", 1232 tooltip => "Apply the audio settings",
1059 on_activate => sub { 1233 on_activate => sub {
1060 audio_shutdown (); 1234 audio_shutdown ();
1061 audio_init (); 1235 audio_init ();
1062 0 1236 0
1063 } 1237 }
1064 ); 1238 );
1065 1239
1066 $vbox->add (new dc::UI::FancyFrame 1240 $vbox->add (new DC::UI::FancyFrame
1067 expand => 1, 1241 expand => 1,
1068 label => "Audio Info", 1242 label => "Audio Info",
1069 child => ($AUDIO_INFO = new dc::UI::Label ellipsise => 0), 1243 child => ($AUDIO_INFO = new DC::UI::Label ellipsise => 0),
1070 ); 1244 );
1071 1245
1072 audio_tab_update; 1246 audio_tab_update;
1073 1247
1074 $vbox 1248 $vbox
1081} 1255}
1082 1256
1083sub make_gauge_window { 1257sub make_gauge_window {
1084 my $gh = int $HEIGHT * $CFG->{gauge_size}; 1258 my $gh = int $HEIGHT * $CFG->{gauge_size};
1085 1259
1086 my $win = new dc::UI::Frame ( 1260 $GAUGES->{win} = my $win = new DC::UI::Frame (
1087 force_x => 0, 1261 force_x => 0,
1088 force_y => "max", 1262 force_y => "max",
1089 force_w => $WIDTH, 1263 force_w => $WIDTH,
1090 force_h => $gh, 1264 force_h => $gh,
1091 ); 1265 );
1092 1266
1093 $win->add (my $hbox = new dc::UI::HBox 1267 $win->add (my $hbox = new DC::UI::HBox
1094 children => [ 1268 children => [
1095 (new dc::UI::HBox expand => 1), 1269 (new DC::UI::HBox expand => 1),
1096 (new dc::UI::VBox children => [ 1270 (new DC::UI::VBox children => [
1097 (new dc::UI::Empty expand => 1), 1271 (new DC::UI::Empty expand => 1),
1098 (new dc::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new dc::UI::Table)), 1272 (new DC::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new DC::UI::Table)),
1099 ]), 1273 ]),
1100 (my $vbox = new dc::UI::VBox), 1274 (my $vbox = new DC::UI::VBox),
1101 ], 1275 ],
1102 ); 1276 );
1103 1277
1104 $vbox->add (new dc::UI::HBox 1278 $vbox->add (new DC::UI::HBox
1105 expand => 1, 1279 expand => 1,
1106 children => [ 1280 children => [
1107 (new dc::UI::Empty expand => 1), 1281 (new DC::UI::Empty expand => 1),
1108 (my $hb = new dc::UI::HBox), 1282 (my $hb = new DC::UI::HBox),
1109 ], 1283 ],
1110 ); 1284 );
1111 1285
1112 $hb->add (my $hg = new dc::UI::Gauge type => 'hp', tooltip => "#stat_health"); 1286 $hb->add ($GAUGES->{hp} = new DC::UI::Gauge type => 'hp', tooltip => "#stat_health");
1113 $hb->add (my $mg = new dc::UI::Gauge type => 'mana', tooltip => "#stat_mana"); 1287 $hb->add ($GAUGES->{mana} = new DC::UI::Gauge type => 'mana', tooltip => "#stat_mana");
1114 $hb->add (my $gg = new dc::UI::Gauge type => 'grace', tooltip => "#stat_grace"); 1288 $hb->add ($GAUGES->{grace} = new DC::UI::Gauge type => 'grace', tooltip => "#stat_grace");
1115 $hb->add (my $fg = new dc::UI::Gauge type => 'food', tooltip => "#stat_food"); 1289 $hb->add ($GAUGES->{food} = new DC::UI::Gauge type => 'food', tooltip => "#stat_food");
1116
1117 $vbox->add (my $exp = new dc::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1, tooltip => "#stat_exp");
1118 $vbox->add (my $prg = new dc::UI::ExperienceProgress);
1119 $vbox->add (my $sklprg = new dc::UI::ExperienceProgress);
1120 $vbox->add (my $rng = new dc::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1, tooltip => "#stat_ranged");
1121
1122 $GAUGES = {
1123 exp => $exp, prg => $prg, sklprg => $sklprg,
1124 win => $win, range => $rng,
1125 hp => $hg, mana => $mg, grace => $gg, food => $fg,
1126 };
1127 1290
1128 &set_gauge_window_fontsize; 1291 &set_gauge_window_fontsize;
1129 1292
1130 $win 1293 $win
1131} 1294}
1132 1295
1133sub debug_setup { 1296sub debug_setup {
1134 my $table = new dc::UI::Table; 1297 my $table = new DC::UI::Table;
1135 1298
1136 $table->add_at (0, 0, new dc::UI::Label text => "Widget Borders"); 1299 $table->add_at (0, 0, new DC::UI::Label text => "Widget Borders");
1137 $table->add_at (1, 0, new dc::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 1; 0 }); 1300 $table->add_at (1, 0, new DC::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 1; 0 });
1138 $table->add_at (0, 1, new dc::UI::Label text => "Tooltip Widget Info"); 1301 $table->add_at (0, 1, new DC::UI::Label text => "Tooltip Widget Info");
1139 $table->add_at (1, 1, new dc::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 2; 0 }); 1302 $table->add_at (1, 1, new DC::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 2; 0 });
1140 $table->add_at (0, 2, new dc::UI::Label text => "Show FPS"); 1303 $table->add_at (0, 2, new DC::UI::Label text => "Show FPS");
1141 $table->add_at (1, 2, new dc::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 4; 0 }); 1304 $table->add_at (1, 2, new DC::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 4; 0 });
1142 $table->add_at (0, 3, new dc::UI::Label text => "Suppress Tooltips"); 1305 $table->add_at (0, 3, new DC::UI::Label text => "Suppress Tooltips");
1143 $table->add_at (1, 3, new dc::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 8; 0 }); 1306 $table->add_at (1, 3, new DC::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 8; 0 });
1144 $table->add_at (0, 4, new dc::UI::Button text => "die on click(tm)", on_activate => sub { &dc::debug() } ); 1307 $table->add_at (0, 4, new DC::UI::Button text => "die on click(tm)", on_activate => sub { &DC::debug() } );
1145 1308
1146 $table->add_at (0, 5, new dc::UI::TextEdit text => "line1\0152\0153");#d# 1309 $table->add_at (0, 5, new DC::UI::TextEdit text => "line1\0152\0153\nµikachu\nづx゙つ゛");#d#
1147 1310
1148 $table->add_at (7,7, my $t = new dc::UI::Table expand => 0); 1311 $table->add_at (7,7, my $t = new DC::UI::Table expand => 0);
1149 $t->add_at (0,0, new dc::UI::Label text => "a a a a", c_rowspan => 1, c_colspan => 2); 1312 $t->add_at (0,0, new DC::UI::Label text => "a a", c_rowspan => 1, c_colspan => 2);
1150 $t->add_at (2,0, new dc::UI::Label text => "b\nb", c_rowspan => 2, c_colspan => 1); 1313 $t->add_at (2,0, new DC::UI::Label text => "b\nb", c_rowspan => 2, c_colspan => 1, ellipsise => 0 );
1151 $t->add_at (1,2, new dc::UI::Label text => "c c c c", c_rowspan => 1, c_colspan => 2); 1314 $t->add_at (1,2, new DC::UI::Label text => "c c", c_rowspan => 1, c_colspan => 2);
1152 $t->add_at (0,1, new dc::UI::Label text => "d\nd", c_rowspan => 2, c_colspan => 1); 1315 $t->add_at (0,1, new DC::UI::Label text => "d\nd", c_rowspan => 2, c_colspan => 1, ellipsise => 0 );
1153 $t->add_at (1,1, new dc::UI::Label text => "e"); 1316 $t->add_at (1,1, new DC::UI::Label text => "e");
1154 1317
1155 $table->add_at (7, 6, my $c = new dc::UI::Canvas); 1318 $table->add_at (7, 6, my $c = new DC::UI::Canvas);
1156 1319
1157 $c->add_items ({ 1320 $c->add_items ({
1158 type => "line_loop", 1321 type => "line_loop",
1159 color => [0, 1, 0], 1322 color => [0, 1, 0],
1160 width => 9, 1323 width => 9,
1180 1343
1181 $table 1344 $table
1182} 1345}
1183 1346
1184sub stats_window { 1347sub stats_window {
1185 my $r = new dc::UI::ScrolledWindow ( 1348 my $r = new DC::UI::ScrolledWindow (
1186 expand => 1, 1349 expand => 1,
1187 scroll_y => 1 1350 scroll_y => 1
1188 ); 1351 );
1189 $r->add (my $vb = new dc::UI::VBox); 1352 $r->add (my $vb = new DC::UI::VBox);
1190 1353
1191 $vb->add (new dc::UI::FancyFrame 1354 $vb->add (new DC::UI::FancyFrame
1192 label => "Player", 1355 label => "Player",
1193 child => (my $pi = new dc::UI::VBox), 1356 child => (my $pi = new DC::UI::VBox),
1194 ); 1357 );
1195 1358
1196 $pi->add ($STATWIDS->{title} = new dc::UI::Label valign => 0, align => -1, text => "Title:", expand => 1, 1359 $pi->add ($STATWIDS->{title} = new DC::UI::Label text => "Title:", expand => 1, align => 0,
1197 can_hover => 1, can_events => 1, 1360 can_hover => 1, can_events => 1,
1198 tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server."); 1361 tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");
1199 $pi->add ($STATWIDS->{map} = new dc::UI::Label valign => 0, align => -1, text => "Map:", expand => 1, 1362 $pi->add ($STATWIDS->{map} = new DC::UI::Label align => 0, text => "Map:", expand => 1,
1200 can_hover => 1, can_events => 1, 1363 can_hover => 1, can_events => 1,
1201 tooltip => "The map you are currently on (if supported by the server)."); 1364 tooltip => "The map you are currently on (if supported by the server).");
1202 1365
1203 $pi->add (my $hb0 = new dc::UI::HBox); 1366 $pi->add (my $hb0 = new DC::UI::HBox);
1204 $hb0->add ($STATWIDS->{weight} = new dc::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1, 1367 $hb0->add ($STATWIDS->{weight} = new DC::UI::Label text => "Weight:", expand => 1, align => 0,
1205 can_hover => 1, can_events => 1, 1368 can_hover => 1, can_events => 1,
1206 tooltip => "The weight of the player including all inventory items."); 1369 tooltip => "The weight of the player including all inventory items.");
1207 $hb0->add ($STATWIDS->{m_weight} = new dc::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1, 1370 $hb0->add ($STATWIDS->{m_weight} = new DC::UI::Label align => 0, text => "Max weight:", expand => 1,
1208 can_hover => 1, can_events => 1, 1371 can_hover => 1, can_events => 1,
1209 tooltip => "The weight limit: you cannot carry more than this."); 1372 tooltip => "The weight limit: you cannot carry more than this.");
1210 1373
1211 $vb->add (new dc::UI::FancyFrame 1374 $vb->add (new DC::UI::FancyFrame
1212 label => "Primary/Secondary Statistics", 1375 label => "Primary/Secondary Statistics",
1213 child => (my $hb = new dc::UI::HBox expand => 1), 1376 child => (my $hb = new DC::UI::HBox expand => 1),
1214 ); 1377 );
1215 $hb->add (my $tbl = new dc::UI::Table expand => 1); 1378 $hb->add (my $tbl = new DC::UI::Table expand => 1);
1216 1379
1217 my $color2 = [1, 1, 0]; 1380 my $color2 = [1, 1, 0];
1218 1381
1219 for ( 1382 for (
1220 [0, 0, st_str => "Str", 30], 1383 [0, 0, st_str => "Str", 30],
1232 [2, 4, st_spd => "Spd", 10.54], 1395 [2, 4, st_spd => "Spd", 10.54],
1233 [2, 5, st_wspd => "WSp", 10.54], 1396 [2, 5, st_wspd => "WSp", 10.54],
1234 ) { 1397 ) {
1235 my ($col, $row, $id, $label, $template) = @$_; 1398 my ($col, $row, $id, $label, $template) = @$_;
1236 1399
1237 $tbl->add_at ($col , $row, $STATWIDS->{$id} = new dc::UI::Label 1400 $tbl->add_at ($col , $row, $STATWIDS->{$id} = new DC::UI::Label
1238 font => $FONT_FIXED, can_hover => 1, can_events => 1, valign => 0, 1401 font => $FONT_FIXED, can_hover => 1, can_events => 1,
1239 align => +1, template => $template, tooltip => "#stat_$label"); 1402 align => 1, template => $template, tooltip => "#stat_$label");
1240 $tbl->add_at ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new dc::UI::Label 1403 $tbl->add_at ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new DC::UI::Label
1241 font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $color2, valign => 0, 1404 font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $color2,
1242 align => -1, text => $label, tooltip => "#stat_$label"); 1405 align => 0, text => $label, tooltip => "#stat_$label");
1243 } 1406 }
1244 1407
1245 $vb->add (new dc::UI::FancyFrame 1408 $vb->add (new DC::UI::FancyFrame
1246 label => "Resistancies", 1409 label => "Resistancies",
1247 child => (my $tbl2 = new dc::UI::Table expand => 1), 1410 child => (my $tbl2 = new DC::UI::Table expand => 1, col_expand => [1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 0]),
1248 ); 1411 );
1249 1412
1250 my $row = 0; 1413 my $row = 0;
1251 my $col = 0; 1414 my $col = 0;
1252 1415
1291 1454
1292 for (qw/slow holyw conf fire depl magic 1455 for (qw/slow holyw conf fire depl magic
1293 drain acid pois para deat phys 1456 drain acid pois para deat phys
1294 blind fear tund elec cold ghit/) 1457 blind fear tund elec cold ghit/)
1295 { 1458 {
1296 $tbl2->add_at ($col, $row, 1459 $tbl2->add_at ($col + 2, $row,
1297 $STATWIDS->{"res_$_"} = 1460 $STATWIDS->{"res_$_"} =
1298 new dc::UI::Label 1461 new DC::UI::Label
1299 font => $FONT_FIXED, 1462 font => $FONT_FIXED,
1300 template => "-100%", 1463 template => "-100%",
1301 align => +1, 1464 align => 1,
1302 valign => 0,
1303 can_events => 1, 1465 can_events => 1,
1304 can_hover => 1, 1466 can_hover => 1,
1305 tooltip => $resist_names{$_}->[1], 1467 tooltip => $resist_names{$_}->[1],
1306 ); 1468 );
1307 $tbl2->add_at ($col + 1, $row, new dc::UI::Image 1469 $tbl2->add_at ($col + 1, $row, new DC::UI::Image
1308 font => $FONT_FIXED, 1470 font => $FONT_FIXED,
1309 can_hover => 1, 1471 can_hover => 1,
1310 can_events => 1, 1472 can_events => 1,
1311 path => "ui/resist/resist_$_.png", 1473 path => "ui/resist/resist_$_.png",
1312 tooltip => $resist_names{$_}->[1], 1474 tooltip => $resist_names{$_}->[1],
1313 ); 1475 );
1314 $tbl2->add_at ($col + 2, $row, new dc::UI::Label 1476 $tbl2->add_at ($col + 0, $row, new DC::UI::Label
1315 text => $resist_names{$_}->[0], 1477 text => $resist_names{$_}->[0],
1316 font => $FONT_FIXED, 1478 font => $FONT_FIXED,
1479 align => 1,
1317 can_hover => 1, 1480 can_hover => 1,
1318 can_events => 1, 1481 can_events => 1,
1319 tooltip => $resist_names{$_}->[1], 1482 tooltip => $resist_names{$_}->[1],
1320 ); 1483 );
1321 1484
1322 $row++; 1485 $row++;
1323 if ($row % 6 == 0) { 1486 if ($row % 6 == 0) {
1324 $col += 3; 1487 $col += 4;
1325 $row = 0; 1488 $row = 0;
1326 } 1489 }
1327 } 1490 }
1328 1491
1329 #update_stats_window ({}); 1492 #update_stats_window ({});
1330 1493
1331 $r 1494 $r
1332} 1495}
1333 1496
1334sub skill_window { 1497sub skill_window {
1335 my $sw = new dc::UI::ScrolledWindow (expand => 1); 1498 my $sw = new DC::UI::ScrolledWindow (expand => 1);
1336 1499
1337 $sw->add ($STATWIDS->{skill_tbl} = new dc::UI::Table expand => 1, col_expand => [0, 0, 1, .1, 0, 0, 1, .1]); 1500 $sw->add ($STATWIDS->{skill_tbl} = new DC::UI::Table expand => 1, col_expand => [0, 0, 1, .1, 0, 0, 1, .1]);
1338 1501
1339 $sw 1502 $sw
1340} 1503}
1341 1504
1342sub formsep($) { 1505sub formsep($) {
1354 return if $METASERVER_ATIME > time; 1517 return if $METASERVER_ATIME > time;
1355 $METASERVER_ATIME = time + 60; 1518 $METASERVER_ATIME = time + 60;
1356 1519
1357 my $table = $METASERVER->{table}; 1520 my $table = $METASERVER->{table};
1358 $table->clear; 1521 $table->clear;
1359 $table->add_at (0, 0, my $label = new dc::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list..."); 1522 $table->add_at (0, 0, my $label = new DC::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
1360 1523
1361 my $ok = 0; 1524 my $ok = 0;
1362 1525
1363 dc::background { 1526 DC::background {
1364 my $ua = dc::lwp_useragent; 1527 my $ua = DC::lwp_useragent;
1365 1528
1366 dc::background_msg dc::decode_json +(dc::lwp_check $ua->get ($META_SERVER))->decoded_content; 1529 DC::background_msg DC::decode_json +(DC::lwp_check $ua->get ($META_SERVER))->decoded_content;
1367 } sub { 1530 } sub {
1368 my ($msg) = @_; 1531 my ($msg) = @_;
1369 if ($msg) { 1532 if ($msg) {
1370 $table->clear; 1533 $table->clear;
1371 1534
1374 "The hostname of the server.", 1537 "The hostname of the server.",
1375 "The time this server has been running without being restarted.", 1538 "The time this server has been running without being restarted.",
1376 "Short information about this server provided by its admins.", 1539 "Short information about this server provided by its admins.",
1377 ); 1540 );
1378 my @col = qw(#Users Host Uptime Version Description); 1541 my @col = qw(#Users Host Uptime Version Description);
1379 $table->add_at ($_, 0, new dc::UI::Label 1542 $table->add_at ($_, 0, new DC::UI::Label
1380 can_hover => 1, can_events => 1, 1543 can_hover => 1, can_events => 1, fg => [1, 1, 0],
1381 align => 0, fg => [1, 1, 0],
1382 text => $col[$_], tooltip => $tip[$_]) 1544 text => $col[$_], tooltip => $tip[$_])
1383 for 0 .. $#col; 1545 for 0 .. $#col;
1384 1546
1385 my @align = qw(1 0 1 1 -1); 1547 my @align = qw(1 0.5 1 1 0);
1386 1548
1387 my $y = 0; 1549 my $y = 0;
1388 for my $m (@{ $msg->{servers} }) { 1550 for my $m (@{ $msg->{servers} }) {
1389 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime, $highlight) = 1551 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime, $highlight) =
1390 @$m{qw(ip age hostname users version description ibytes obytes uptime highlight)}; 1552 @$m{qw(ip age hostname users version description ibytes obytes uptime highlight)};
1406 1568
1407 $m = [$users, $host, $uptime, $version, $desc]; 1569 $m = [$users, $host, $uptime, $version, $desc];
1408 1570
1409 $y++; 1571 $y++;
1410 1572
1411 $table->add_at (scalar @$m, $y, new dc::UI::VBox children => [ 1573 $table->add_at (scalar @$m, $y, new DC::UI::VBox children => [
1412 (new dc::UI::Button 1574 (new DC::UI::Button
1413 text => "Use", 1575 text => "Use",
1414 tooltip => "Put this server into the <b>Host:Port</b> field", 1576 tooltip => "Put this server into the <b>Host:Port</b> field",
1415 on_activate => sub { 1577 on_activate => sub {
1416 $HOST_ENTRY->set_text ($CFG->{profile}{default}{host} = $host); 1578 $HOST_ENTRY->set_text ($CFG->{profile}{default}{host} = $host);
1417 $METASERVER->hide; 1579 $METASERVER->hide;
1418 0 1580 0
1419 }, 1581 },
1420 ), 1582 ),
1421 (new dc::UI::Empty expand => 1), 1583 (new DC::UI::Empty expand => 1),
1422 ]); 1584 ]);
1423 1585
1424 $table->add_at ($_, $y, new dc::UI::Label 1586 $table->add_at ($_, $y, new DC::UI::Label
1425 max_w => $::WIDTH * 0.4, 1587 max_w => $::WIDTH * 0.4,
1426 ellipsise => 0, 1588 ellipsise => 0,
1427 align => $align[$_], 1589 align => $align[$_],
1428 text => $m->[$_], 1590 text => $m->[$_],
1429 tooltip => $tip[$_], 1591 tooltip => $tip[$_],
1439 }; 1601 };
1440 1602
1441} 1603}
1442 1604
1443sub metaserver_dialog { 1605sub metaserver_dialog {
1444 my $vbox = new dc::UI::VBox; 1606 my $vbox = new DC::UI::VBox;
1445 my $table = new dc::UI::Table; 1607 my $table = new DC::UI::Table;
1446 $vbox->add (new dc::UI::ScrolledWindow expand => 1, child => $table); 1608 $vbox->add (new DC::UI::ScrolledWindow expand => 1, child => $table);
1447 1609
1448 my $dialog = new dc::UI::Toplevel 1610 my $dialog = new DC::UI::Toplevel
1449 title => "Server List", 1611 title => "Server List",
1450 name => 'metaserver_dialog', 1612 name => 'metaserver_dialog',
1451 x => 'center', 1613 x => 'center',
1452 y => 'center', 1614 y => 'center',
1453 z => 3, 1615 z => 3,
1464 1626
1465 $dialog 1627 $dialog
1466} 1628}
1467 1629
1468sub login_setup { 1630sub login_setup {
1469 my $vbox = new dc::UI::VBox; 1631 my $vbox = new DC::UI::VBox;
1470 1632
1471 $vbox->add (new dc::UI::FancyFrame 1633 $vbox->add (new DC::UI::FancyFrame
1472 label => "Login Settings", 1634 label => "Login Settings",
1473 child => (my $table = new dc::UI::Table expand => 1, col_expand => [0, 1]), 1635 child => (my $table = new DC::UI::Table expand => 1, col_expand => [0, 1]),
1474 ); 1636 );
1475 1637
1476 $table->add_at (0, 4, new dc::UI::Label valign => 0, align => 1, text => "Username"); 1638 $table->add_at (0, 4, new DC::UI::Label align => 1, text => "Username");
1477 $table->add_at (1, 4, new dc::UI::Entry 1639 $table->add_at (1, 4, new DC::UI::Entry
1478 text => $CFG->{profile}{default}{user}, 1640 text => $CFG->{profile}{default}{user},
1479 tooltip => "The name of your character on the server.", 1641 tooltip => "The name of your character on the server.",
1480 on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{user} = $value; 1 } 1642 on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{user} = $value; 1 }
1481 ); 1643 );
1482 1644
1483 $table->add_at (0, 5, new dc::UI::Label valign => 0, align => 1, text => "Password"); 1645 $table->add_at (0, 5, new DC::UI::Label align => 1, text => "Password");
1484 $table->add_at (1, 5, new dc::UI::Entry 1646 $table->add_at (1, 5, new DC::UI::Entry
1485 text => $CFG->{profile}{default}{password}, 1647 text => $CFG->{profile}{default}{password},
1486 hidden => 1, 1648 hidden => 1,
1487 tooltip => "The password for your character.", 1649 tooltip => "The password for your character.",
1488 on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{password} = $value; 1 } 1650 on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{password} = $value; 1 }
1489 ); 1651 );
1490 1652
1491 $table->add_at (1, 11, $LOGIN_BUTTON = new dc::UI::Button 1653 $table->add_at (1, 11, $LOGIN_BUTTON = new DC::UI::Button
1492 expand => 1, 1654 expand => 1,
1493 align => 0,
1494 text => "Login / Register", 1655 text => "Login / Register",
1495 tooltip => "This button will either login to the account configured above or register a new account.", 1656 tooltip => "This button will either login to the account configured above or register a new account.",
1496 on_activate => sub { 1657 on_activate => sub {
1497 $CONN ? stop_game 1658 $CONN ? stop_game
1498 : start_game; 1659 : start_game;
1499 1 1660 1
1500 }, 1661 },
1501 ); 1662 );
1502 1663
1503 $vbox->add (new dc::UI::FancyFrame 1664 $vbox->add (new DC::UI::FancyFrame
1504 label => "Registering", 1665 label => "How to Play",
1505 min_h => 200, 1666 min_h => 240,
1506 child => (new dc::UI::Label valign => -1, ellipsise => 0, 1667 child => (new DC::UI::Label valign => 0, ellipsise => 0,
1507 markup => 1668 markup =>
1669 "First select a suitable video resolution in the <b>Graphics</b> tab, above.\n\n"
1670 . "Then register a new account (or use an existing one if you have one). "
1508 "To register a new account, choose a username that hasn't been taken yet and " 1671 . "To register an account, choose a username that hasn't been taken yet (just guess) and "
1509 . "try to log-in. Follow the instructions in the Log tab in the message window.", 1672 . "try to log-in. Follow the instructions in the Log tab in the message window.",
1510 ), 1673 ),
1511 ); 1674 );
1512 1675
1513 $vbox 1676 $vbox
1514} 1677}
1515 1678
1516sub server_setup { 1679sub server_setup {
1517 my $vbox = new dc::UI::VBox; 1680 my $vbox = new DC::UI::VBox;
1518 1681
1519 $vbox->add (new dc::UI::FancyFrame 1682 $vbox->add (new DC::UI::FancyFrame
1520 label => "Connection Settings", 1683 label => "Connection Settings",
1521 child => (my $table = new dc::UI::Table expand => 1, col_expand => [0, 1]), 1684 child => (my $table = new DC::UI::Table expand => 1, col_expand => [0, 1]),
1522 ); 1685 );
1523 1686
1524 my $row = 0; 1687 my $row = 0;
1525 1688
1526 $table->add_at (0, ++$row, new dc::UI::Label valign => 0, align => 1, text => "Host:Port"); 1689 $table->add_at (0, ++$row, new DC::UI::Label align => 1, text => "Host:Port");
1527 { 1690 {
1528 $table->add_at (1, $row, my $vbox = new dc::UI::VBox); 1691 $table->add_at (1, $row, my $vbox = new DC::UI::VBox);
1529 1692
1530 $vbox->add ( 1693 $vbox->add (
1531 $HOST_ENTRY = new dc::UI::Entry 1694 $HOST_ENTRY = new DC::UI::Entry
1532 expand => 1, 1695 expand => 1,
1533 text => $CFG->{profile}{default}{host}, 1696 text => $CFG->{profile}{default}{host},
1534 tooltip => "The hostname or ip address of the Deliantra server to connect to", 1697 tooltip => "The hostname or ip address of the Deliantra server to connect to (e.g. <b>gameserver.deliantra.net</b>)",
1535 on_changed => sub { 1698 on_changed => sub {
1536 my ($self, $value) = @_; 1699 my ($self, $value) = @_;
1537 $CFG->{profile}{default}{host} = $value; 1700 $CFG->{profile}{default}{host} = $value;
1538 1 1701 1
1539 } 1702 }
1540 ); 1703 );
1541 1704
1542 if (0) { #d# disabled 1705 if (0) { #d# disabled
1543 $vbox->add (new dc::UI::Button 1706 $vbox->add (new DC::UI::Button
1544 expand => 1, 1707 expand => 1,
1545 text => "Server List", 1708 text => "Server List",
1546 other => $METASERVER, 1709 other => $METASERVER,
1547 tooltip => "Show a list of available crossfire servers", 1710 tooltip => "Show a list of available Deliantra servers",
1548 on_activate => sub { $METASERVER->toggle_visibility; 0 }, 1711 on_activate => sub { $METASERVER->toggle_visibility; 0 },
1549 on_visibility_change => sub { $METASERVER->hide unless $_[1]; 1 }, 1712 on_visibility_change => sub { $METASERVER->hide unless $_[1]; 1 },
1550 ); 1713 );
1551 }#d# 1714 }#d#
1552 } 1715 }
1553 1716
1554 $table->add_at (0, ++$row, new dc::UI::Label valign => 0, align => 1, text => "Map Size"); 1717 $table->add_at (0, ++$row, new DC::UI::Label align => 1, text => "Map Size");
1555 $table->add_at (1, $row, new dc::UI::Slider 1718 $table->add_at (1, $row, new DC::UI::Slider
1556 force_w => 100, 1719 force_w => 100,
1557 range => [$CFG->{mapsize}, 10, 100, 0, 1], 1720 range => [$CFG->{mapsize}, 10, 100, 0, 1],
1558 tooltip => "This is the size of the portion of the map update the server sends you. " 1721 tooltip => "This is the size of the portion of the map update the server sends you. "
1559 . "If you set this to a high value you will be able to see further, " 1722 . "If you set this to a high value you will be able to see further, "
1560 . "but you also increase bandwidth requirements and latency. " 1723 . "but you also increase bandwidth requirements and latency. "
1561 . "This option is only used once at log-in.", 1724 . "This option is only used once at log-in.",
1562 on_changed => sub { my ($self, $value) = @_; $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 1 }, 1725 on_changed => sub { my ($self, $value) = @_; $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 1 },
1563 ); 1726 );
1564 1727
1565 $table->add_at (0, ++$row, new dc::UI::Label valign => 0, align => 1, text => "Output-Rate"); 1728 $table->add_at (0, ++$row, new DC::UI::Label align => 1, text => "Output-Rate");
1566 $table->add_at (1, $row, new dc::UI::Entry 1729 $table->add_at (1, $row, new DC::UI::Entry
1567 text => $CFG->{output_rate}, 1730 text => $CFG->{output_rate},
1568 tooltip => "The maximum bandwidth in bytes per second that the server should not exceed " 1731 tooltip => "The maximum bandwidth in bytes per second that the server should not exceed "
1569 . "when sending data. When 0 or unset, the server " 1732 . "when sending data. When 0 or unset, the server "
1570 . "default will be used, which is usually around 100kb/s. Most servers will " 1733 . "default will be used, which is usually around 100kb/s. Most servers will "
1571 . "dynamically find an optimal rate, so adjust this only when necessary.", 1734 . "dynamically find an optimal rate, so adjust this only when necessary.",
1572 on_changed => sub { $CFG->{output_rate} = $_[1]; 1 }, 1735 on_changed => sub { $CFG->{output_rate} = $_[1]; 1 },
1573 ); 1736 );
1574 1737
1575 $vbox->add (new dc::UI::FancyFrame 1738 $vbox->add (new DC::UI::FancyFrame
1576 label => "Server Info", 1739 label => "Server Info",
1577 child => ($SERVER_INFO = new dc::UI::Label ellipsise => 0), 1740 child => ($SERVER_INFO = new DC::UI::Label ellipsise => 0),
1578 ); 1741 );
1579 1742
1580 $vbox 1743 $vbox
1581} 1744}
1582 1745
1583sub client_setup { 1746sub client_setup {
1584 my $table = new dc::UI::Table expand => 1, col_expand => [0, 1]; 1747 my $table = new DC::UI::Table expand => 1, col_expand => [0, 1];
1585 1748
1586 my $row = 0; 1749 my $row = 0;
1587 1750
1588 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Tip of the day"); 1751 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Tip of the day");
1589 $table->add_at (1, $row++, new dc::UI::CheckBox 1752 $table->add_at (1, $row++, new DC::UI::CheckBox
1753 c_colspan => 2,
1590 state => $CFG->{show_tips}, 1754 state => $CFG->{show_tips},
1591 tooltip => "Show the <b>Tip of the day</b> window at startup?", 1755 tooltip => "Show the <b>Tip of the day</b> window at startup?",
1592 on_changed => sub { 1756 on_changed => sub {
1593 my ($self, $value) = @_; 1757 my ($self, $value) = @_;
1594 $CFG->{show_tips} = $value; 1758 $CFG->{show_tips} = $value;
1595 0 1759 0
1596 } 1760 }
1597 ); 1761 );
1598 1762
1599 $table->add_at (0, $row, new dc::UI::Label valign => 0, align => 1, text => "Messages Window Size"); 1763 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Message Window Size");
1600 $table->add_at (1, $row++, my $saycmd = new dc::UI::Entry 1764 $table->add_at (1, $row++, my $saycmd = new DC::UI::Entry
1765 c_colspan => 2,
1601 text => $CFG->{logview_max_par}, 1766 text => $CFG->{logview_max_par},
1602 tooltip => "This is maximum number of messages remembered in the <b>Messages</b> window. If the server " 1767 tooltip => "This is maximum number of messages remembered in the <b>Message</b> window. If the server "
1603 . "sends more messages than this number, older messages get removed to save memory and " 1768 . "sends more messages than this number, older messages get removed to save memory and "
1604 . "computing time. A value of <b>0</b> disables this feature, but that is not recommended.", 1769 . "computing time. A value of <b>0</b> disables this feature, but that is not recommended.",
1605 on_changed => sub { 1770 on_changed => sub {
1606 my ($self, $value) = @_; 1771 my ($self, $value) = @_;
1607 $MESSAGE_WINDOW->set_max_para ($CFG->{logview_max_par} = $value*1); 1772 $MESSAGE_DIST->set_max_par ($CFG->{logview_max_par} = $value*1);
1608 0 1773 0
1609 }, 1774 },
1610 ); 1775 );
1611 1776
1777 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Config Autosave");
1778 $table->add_at (1, $row, new DC::UI::CheckBox
1779 state => $CFG->{config_autosave},
1780 tooltip => "Normally, configuration settings and the user interface layout "
1781 . "are saved on client exit. You can disable this behaviour by "
1782 . "unchecking this checkbox.",
1783 on_changed => sub {
1784 my ($self, $value) = @_;
1785 $CFG->{config_autosave} = $value;
1786 0
1787 }
1788 );
1789 $table->add_at (2, $row++, new DC::UI::Button
1790 text => "Save Now",
1791 tooltip => "Use this to manually save configuration and UI layout when "
1792 . "autosave is disabled.",
1793 on_activate => sub {
1794 DC::write_cfg;
1795 0
1796 }
1797 );
1798
1612 $table 1799 $table
1613} 1800}
1614 1801
1615sub autopickup_setup { 1802sub autopickup_setup {
1616 my $r = new dc::UI::ScrolledWindow ( 1803 my $r = new DC::UI::ScrolledWindow (
1617 expand => 1, 1804 expand => 1,
1618 scroll_y => 1 1805 scroll_y => 1
1619 ); 1806 );
1620 $r->add (my $table = new dc::UI::Table 1807 $r->add (my $table = new DC::UI::Table
1621 row_expand => [0], 1808 row_expand => [0],
1622 col_expand => [0, 1, 0, 1], 1809 col_expand => [0, 1, 0, 1],
1623 ); 1810 );
1624 1811
1625 for ( 1812 for (
1659 ["Magic Devices" => PICKUP_MAGIC_DEVICE], 1846 ["Magic Devices" => PICKUP_MAGIC_DEVICE],
1660 ["Ignore cursed" => PICKUP_NOT_CURSED], 1847 ["Ignore cursed" => PICKUP_NOT_CURSED],
1661 ["Jewelery" => PICKUP_JEWELS], 1848 ["Jewelery" => PICKUP_JEWELS],
1662 ["Flesh" => PICKUP_FLESH], 1849 ["Flesh" => PICKUP_FLESH],
1663 ], 1850 ],
1664 ["Weight/Value ratio", 2, 17] 1851 ["Value/Weight ratio", 2, 17]
1665 ) 1852 )
1666 { 1853 {
1667 my ($title, $x, $y, @bits) = @$_; 1854 my ($title, $x, $y, @bits) = @$_;
1668 $table->add_at ($x, $y, new dc::UI::Label text => $title, align => 1, fg => [1, 1, 0]); 1855 $table->add_at ($x, $y, new DC::UI::Label text => $title, align => 1, fg => [1, 1, 0]);
1669 1856
1670 for (@bits) { 1857 for (@bits) {
1671 ++$y; 1858 ++$y;
1672 1859
1673 my $mask = $_->[1]; 1860 my $mask = $_->[1];
1674 $table->add_at ($x , $y, new dc::UI::Label text => $_->[0], align => 1, expand => 1); 1861 $table->add_at ($x , $y, new DC::UI::Label text => $_->[0], align => 1, expand => 1);
1675 $table->add_at ($x+1, $y, my $checkbox = new dc::UI::CheckBox 1862 $table->add_at ($x+1, $y, my $checkbox = new DC::UI::CheckBox
1676 state => $::CFG->{pickup} & $mask, 1863 state => $::CFG->{pickup} & $mask,
1677 on_changed => sub { 1864 on_changed => sub {
1678 my ($box, $value) = @_; 1865 my ($box, $value) = @_;
1679 1866
1680 if ($value) { 1867 if ($value) {
1691 1878
1692 ${$_->[2]} = $checkbox if $_->[2]; 1879 ${$_->[2]} = $checkbox if $_->[2];
1693 } 1880 }
1694 } 1881 }
1695 1882
1696 $table->add_at (2, 18, new dc::UI::ValSlider 1883 $table->add_at (2, 18, new DC::UI::ValSlider
1697 range => [$::CFG->{pickup} & 0xF, 0, 16, 1, 1], 1884 range => [$::CFG->{pickup} & 0xF, 0, 16, 1, 1],
1698 template => ">= 99", 1885 template => ">= 99",
1886 tooltip => "Pick up items whose value/weight (silver/kg) ratio is equal or higher than this setting (which is specified in gold coins).",
1699 to_value => sub { ">= " . 5 * $_[0] }, 1887 to_value => sub { ">= " . 5 * $_[0] },
1700 on_changed => sub { 1888 on_changed => sub {
1701 my ($slider, $value) = @_; 1889 my ($slider, $value) = @_;
1702 1890
1703 $::CFG->{pickup} &= ~0xF; 1891 $::CFG->{pickup} &= ~0xF;
1704 $::CFG->{pickup} |= int $value 1892 $::CFG->{pickup} |= int $value
1705 if $value; 1893 if $value;
1706 1; 1894 1;
1707 }); 1895 });
1708 1896
1709 $table->add_at (3, 18, new dc::UI::Button 1897 $table->add_at (3, 18, new DC::UI::Button
1710 text => "set", 1898 text => "set",
1711 on_activate => sub { 1899 on_activate => sub {
1712 $::CONN->send_command ("pickup $::CFG->{pickup}") 1900 $::CONN->send_command ("pickup $::CFG->{pickup}")
1713 if defined $::CONN; 1901 if defined $::CONN;
1714 0 1902 0
1716 1904
1717 $r 1905 $r
1718} 1906}
1719 1907
1720my %SORT_ORDER = ( 1908my %SORT_ORDER = (
1721 type => undef, 1909 type => sub {
1910 sort { $a->{type} <=> $b->{type} or $a->{name} cmp $b->{name} } @_
1911 },
1722 mtime => sub { 1912 mtime => sub {
1723 my $NOW = time; 1913 my $NOW = time;
1724 sort { 1914 sort {
1725 my $atime = $a->{mtime} - $NOW; $atime = $atime < 5 * 60 ? int $atime / 60 : 6; 1915 my $atime = $a->{mtime} - $NOW; $atime = $atime < 5 * 60 ? int $atime / 60 : 6;
1726 my $btime = $b->{mtime} - $NOW; $btime = $btime < 5 * 60 ? int $btime / 60 : 6; 1916 my $btime = $b->{mtime} - $NOW; $btime = $btime < 5 * 60 ? int $btime / 60 : 6;
1735 or $a->{type} <=> $b->{type} 1925 or $a->{type} <=> $b->{type}
1736 } @_ }, 1926 } @_ },
1737); 1927);
1738 1928
1739sub inventory_widget { 1929sub inventory_widget {
1740 my $hb = new dc::UI::HBox homogeneous => 1; 1930 my $hb = new DC::UI::HBox homogeneous => 1;
1741 1931
1742 $hb->add (my $vb1 = new dc::UI::VBox); 1932 $hb->add (my $vb1 = new DC::UI::VBox);
1743 $vb1->add (new dc::UI::Label align => 0, text => "Player"); 1933 $vb1->add (new DC::UI::Label text => "Player");
1744 1934
1745 $vb1->add (my $hb1 = new dc::UI::HBox); 1935 $vb1->add (my $hb1 = new DC::UI::HBox);
1746 1936
1747 use sort 'stable'; 1937 use sort 'stable';
1748 1938
1749 $hb1->add (new dc::UI::Selector 1939 $hb1->add (new DC::UI::Selector
1750 value => $::CFG->{inv_sort}, 1940 value => $::CFG->{inv_sort},
1751 options => [ 1941 options => [
1752 [type => "Type/Name"], 1942 [type => "Type/Name"],
1753 [mtime => "Recent/Normal/Locked"], 1943 [mtime => "Recent/Normal/Locked"],
1754 [weight => "Weight/Type"], 1944 [weight => "Weight/Type"],
1756 on_changed => sub { 1946 on_changed => sub {
1757 $::CFG->{inv_sort} = $_[1]; 1947 $::CFG->{inv_sort} = $_[1];
1758 $INV->set_sort_order ($SORT_ORDER{$_[1]}); 1948 $INV->set_sort_order ($SORT_ORDER{$_[1]});
1759 }, 1949 },
1760 ); 1950 );
1761 $hb1->add (new dc::UI::Label text => "Weight: ", align => 1, expand => 1); 1951 $hb1->add (new DC::UI::Label text => "Weight: ", align => 1, expand => 1);
1762 #TODO# update to weigh/maxweight 1952 #TODO# update to weight/maxweight
1763 $hb1->add ($STATWIDS->{i_weight} = new dc::UI::Label align => -1); 1953 $hb1->add ($STATWIDS->{i_weight} = new DC::UI::Label align => 0);
1764 1954
1765 $vb1->add (my $sw1 = new dc::UI::ScrolledWindow expand => 1, scroll_y => 1); 1955 $vb1->add (my $sw1 = new DC::UI::ScrolledWindow expand => 1, scroll_y => 1);
1766 $sw1->add ($INV = new dc::UI::Inventory); 1956 $sw1->add ($INV = new DC::UI::Inventory);
1767 $INV->set_sort_order ($SORT_ORDER{$::CFG->{inv_sort}}); 1957 $INV->set_sort_order ($SORT_ORDER{$::CFG->{inv_sort}});
1768 1958
1769 $hb->add (my $vb2 = new dc::UI::VBox); 1959 $hb->add (my $vb2 = new DC::UI::VBox);
1770 1960
1771 $vb2->add ($INVR_HB = new dc::UI::HBox); 1961 $vb2->add ($INVR_HB = new DC::UI::HBox);
1772 1962
1773 $vb2->add (my $sw2 = new dc::UI::ScrolledWindow expand => 1, scroll_y => 1); 1963 $vb2->add (my $sw2 = new DC::UI::ScrolledWindow expand => 1, scroll_y => 1);
1774 $sw2->add ($INVR = new dc::UI::Inventory); 1964 $sw2->add ($INVR = new DC::UI::Inventory);
1775 1965
1776 # XXX: Call after $INVR = ... because set_opencont sets the items 1966 # XXX: Call after $INVR = ... because set_opencont sets the items
1777 dc::Protocol::set_opencont ($::CONN, 0, "Floor"); 1967 DC::Protocol::set_opencont ($::CONN, 0, "Floor");
1778 1968
1779 $hb 1969 $hb
1780} 1970}
1781 1971
1782sub media_window { 1972sub media_window {
1783 my $vb = new dc::UI::VBox; 1973 my $vb = new DC::UI::VBox;
1784 1974
1785 $vb->add (new dc::UI::FancyFrame 1975 $vb->add (new DC::UI::FancyFrame
1786 label => "Currently playing music", 1976 label => "Currently playing music",
1787 child => new dc::UI::ScrolledWindow scroll_x => 1, scroll_y => 0, 1977 child => new DC::UI::ScrolledWindow scroll_x => 1, scroll_y => 0,
1788 child => ($MUSIC_PLAYING_WIDGET = new dc::UI::Label ellipsise => 0, fontsize => 0.8), 1978 child => ($MUSIC_PLAYING_WIDGET = new DC::UI::Label ellipsise => 0, fontsize => 0.8),
1789 ); 1979 );
1790 1980
1791 $vb->add (new dc::UI::FancyFrame 1981 $vb->add (new DC::UI::FancyFrame
1792 label => "Other media used in this session", 1982 label => "Other media used in this session",
1793 expand => 1, 1983 expand => 1,
1794 child => ($LICENSE_WIDGET = new dc::UI::TextScroller 1984 child => ($LICENSE_WIDGET = new DC::UI::TextScroller
1795 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4), 1985 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4),
1796 ); 1986 );
1797 1987
1798 $vb 1988 $vb
1799} 1989}
1808 or return; 1998 or return;
1809 1999
1810 $LICENSE_WIDGET->add_paragraph ({ 2000 $LICENSE_WIDGET->add_paragraph ({
1811 fg => [1, 1, 1, 1], 2001 fg => [1, 1, 1, 1],
1812 markup => "<small>" 2002 markup => "<small>"
1813 . "<b>Name:</b> " . (dc::asxml $meta->{name}) . "\n" 2003 . "<b>Name:</b> " . (DC::asxml $meta->{name}) . "\n"
1814 . "<b>Author:</b> " . (dc::asxml $meta->{author}) . "\n" 2004 . "<b>Author:</b> " . (DC::asxml $meta->{author}) . "\n"
1815 . "<b>Source:</b> " . (dc::asxml $meta->{source}) . "\n" 2005 . "<b>Source:</b> " . (DC::asxml $meta->{source}) . "\n"
1816 . "<b>License:</b> " . (dc::asxml $meta->{license}) . "\n" 2006 . "<b>License:</b> " . (DC::asxml $meta->{license}) . "\n"
1817 . "</small>", 2007 . "</small>",
1818 }); 2008 });
1819 $LICENSE_WIDGET->scroll_to_bottom; 2009 $LICENSE_WIDGET->scroll_to_bottom;
1820} 2010}
1821 2011
1828 $PL_NOTEBOOK->set_current_page ($widget); 2018 $PL_NOTEBOOK->set_current_page ($widget);
1829 $PL_WINDOW->show; 2019 $PL_WINDOW->show;
1830 } 2020 }
1831} 2021}
1832 2022
1833sub player_window { 2023sub make_playerbook {
1834 my $plwin = $PL_WINDOW = new dc::UI::Toplevel 2024 my $plwin = $PL_WINDOW = new DC::UI::Toplevel
1835 x => "center", 2025 x => "center",
1836 y => "center", 2026 y => "center",
1837 force_w => $WIDTH * 9/10, 2027 force_w => $WIDTH * 9/10,
1838 force_h => $HEIGHT * 9/10, 2028 force_h => $HEIGHT * 9/10,
1839 title => "Player", 2029 title => "Player",
1841 has_close_button => 1 2031 has_close_button => 1
1842 ; 2032 ;
1843 2033
1844 my $ntb = 2034 my $ntb =
1845 $PL_NOTEBOOK = 2035 $PL_NOTEBOOK =
1846 new dc::UI::Notebook expand => 1; 2036 new DC::UI::Notebook expand => 1;
1847 2037
1848 $ntb->add_tab ( 2038 $ntb->add_tab (
1849 "Statistics (F2)" => $STATS_PAGE = stats_window, 2039 "Statistics (F2)" => $STATS_PAGE = stats_window,
1850 "Shows statistics, where all your Stats and Resistances are shown." 2040 "Shows statistics, where all your Stats and Resistances are shown."
1851 ); 2041 );
1852 $ntb->add_tab ( 2042 $ntb->add_tab (
1853 "Skills (F3)" => $SKILL_PAGE = skill_window, 2043 "Skills (F3)" => $SKILL_PAGE = skill_window,
1854 "Shows all your Skills." 2044 "Shows all your Skills."
1855 ); 2045 );
1856 2046
1857 my $spellsw = $SPELL_PAGE = new dc::UI::ScrolledWindow (expand => 1, scroll_y => 1); 2047 my $spellsw = $SPELL_PAGE = new DC::UI::ScrolledWindow (expand => 1, scroll_y => 1);
1858 $spellsw->add ($SPELL_LIST = new dc::UI::SpellList); 2048 $spellsw->add ($SPELL_LIST = new DC::UI::SpellList);
1859 $ntb->add_tab ( 2049 $ntb->add_tab (
1860 "Spellbook (F4)" => $spellsw, 2050 "Spellbook (F4)" => $spellsw,
1861 "Displays all spells you have and lets you edit keyboard shortcuts for them." 2051 "Displays all spells you have and lets you edit keyboard shortcuts for them."
1862 ); 2052 );
1863 $ntb->add_tab ( 2053 $ntb->add_tab (
1872 "License, Author and Source info for media sent by the server."); 2062 "License, Author and Source info for media sent by the server.");
1873 2063
1874 $ntb->set_current_page ($INVENTORY_PAGE); 2064 $ntb->set_current_page ($INVENTORY_PAGE);
1875 2065
1876 $plwin->add ($ntb); 2066 $plwin->add ($ntb);
1877 $plwin
1878} 2067}
1879 2068
1880sub keyboard_setup { 2069sub keyboard_setup {
1881 dc::Macro::keyboard_setup 2070 DC::Macro::keyboard_setup
1882} 2071}
1883 2072
1884sub help_window { 2073sub help_window {
1885 my $win = new dc::UI::Toplevel 2074 my $win = new DC::UI::Toplevel
1886 x => 'center', 2075 x => 'center',
1887 y => 'center', 2076 y => 'center',
1888 z => 4, 2077 z => 4,
1889 name => 'doc_browser', 2078 name => 'doc_browser',
1890 force_w => int $WIDTH * 7/8, 2079 force_w => int $WIDTH * 7/8,
1891 force_h => int $HEIGHT * 7/8, 2080 force_h => int $HEIGHT * 7/8,
1892 title => "Help Browser", 2081 title => "Help Browser",
1893 has_close_button => 1; 2082 has_close_button => 1;
1894 2083
1895 $win->add (my $vbox = new dc::UI::VBox); 2084 $win->add (my $vbox = new DC::UI::VBox);
1896 2085
1897 $vbox->add (new dc::UI::FancyFrame 2086 $vbox->add (new DC::UI::FancyFrame
1898 label => "Navigation", 2087 label => "Navigation",
1899 child => (my $buttons = new dc::UI::HBox), 2088 child => (my $buttons = new DC::UI::HBox),
1900 ); 2089 );
1901 $vbox->add (my $viewer = new dc::UI::TextScroller 2090 $vbox->add (my $viewer = new DC::UI::TextScroller
1902 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4); 2091 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
1903 2092
1904 my @history; 2093 my @history;
1905 my @future; 2094 my @future;
1906 my $curnode; 2095 my $curnode;
1908 my $load_node; $load_node = sub { 2097 my $load_node; $load_node = sub {
1909 my ($node, $para) = @_; 2098 my ($node, $para) = @_;
1910 2099
1911 $buttons->clear; 2100 $buttons->clear;
1912 2101
1913 $buttons->add (new dc::UI::Button 2102 $buttons->add (new DC::UI::Button
1914 text => "⇤", 2103 text => "⇤",
1915 tooltip => "back to the starting page", 2104 tooltip => "back to the starting page",
1916 on_activate => sub { 2105 on_activate => sub {
1917 unshift @future, [$curnode, $viewer->current_paragraph] if $curnode; 2106 unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
1918 unshift @future, @history; 2107 unshift @future, @history;
1920 $load_node->(@{shift @future}); 2109 $load_node->(@{shift @future});
1921 }, 2110 },
1922 ); 2111 );
1923 2112
1924 if (@history) { 2113 if (@history) {
1925 $buttons->add (new dc::UI::Button 2114 $buttons->add (new DC::UI::Button
1926 text => "⋘", 2115 text => "⋘",
1927 tooltip => "back to <i>" . (dc::asxml dc::Pod::full_path $history[-1][0]) . "</i>", 2116 tooltip => "back to <i>" . (DC::asxml DC::Pod::full_path $history[-1][0]) . "</i>",
1928 on_activate => sub { 2117 on_activate => sub {
1929 unshift @future, [$curnode, $viewer->current_paragraph] if $curnode; 2118 unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
1930 $load_node->(@{pop @history}); 2119 $load_node->(@{pop @history});
1931 }, 2120 },
1932 ); 2121 );
1933 } 2122 }
1934 2123
1935 if (@future) { 2124 if (@future) {
1936 $buttons->add (new dc::UI::Button 2125 $buttons->add (new DC::UI::Button
1937 text => "⋙", 2126 text => "⋙",
1938 tooltip => "forward to <i>" . (dc::asxml dc::Pod::full_path $future[0][0]) . "</i>", 2127 tooltip => "forward to <i>" . (DC::asxml DC::Pod::full_path $future[0][0]) . "</i>",
1939 on_activate => sub { 2128 on_activate => sub {
1940 push @history, [$curnode, $viewer->current_paragraph]; 2129 push @history, [$curnode, $viewer->current_paragraph];
1941 $load_node->(@{shift @future}); 2130 $load_node->(@{shift @future});
1942 }, 2131 },
1943 ); 2132 );
1944 } 2133 }
1945 2134
1946 $buttons->add (new dc::UI::Label text => " "); 2135 $buttons->add (new DC::UI::Label text => " ");
1947 2136
1948 my @path = dc::Pod::full_path_of $node; 2137 my @path = DC::Pod::full_path_of $node;
1949 pop @path; # drop current node 2138 pop @path; # drop current node
1950 2139
1951 for my $node (@path) { 2140 for my $node (@path) {
1952 $buttons->add (new dc::UI::Button 2141 $buttons->add (new DC::UI::Button
1953 text => $node->{kw}[0], 2142 text => $node->[DC::Pod::N_KW][0],
1954 tooltip => "go to <i>" . (dc::asxml dc::Pod::full_path $node) . "</i>", 2143 tooltip => "go to <i>" . (DC::asxml DC::Pod::full_path $node) . "</i>",
1955 on_activate => sub { 2144 on_activate => sub {
1956 push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = (); 2145 push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
1957 $load_node->($node); 2146 $load_node->($node);
1958 }, 2147 },
1959 ); 2148 );
1960 $buttons->add (new dc::UI::Label text => "/"); 2149 $buttons->add (new DC::UI::Label text => "/");
1961 } 2150 }
1962 2151
1963 $buttons->add (new dc::UI::Label text => $node->{kw}[0], padding_x => 4, padding_y => 4); 2152 $buttons->add (new DC::UI::Label text => $node->[DC::Pod::N_KW][0], padding_x => 4, padding_y => 4);
1964 2153
1965 $curnode = $node; 2154 $curnode = $node;
1966 2155
1967 $viewer->clear; 2156 $viewer->clear;
1968 $viewer->add_paragraph (dc::Pod::as_paragraphs dc::Pod::section_of $curnode); 2157 $viewer->add_paragraph (DC::Pod::as_paragraphs DC::Pod::section_of $curnode);
1969 $viewer->scroll_to ($para); 2158 $viewer->scroll_to ($para);
1970 }; 2159 };
1971 2160
1972 $load_node->(dc::Pod::find pod => "mainpage"); 2161 $load_node->(DC::Pod::find pod => "mainpage");
1973 2162
1974 $dc::Pod::goto_document = sub { 2163 $DC::Pod::goto_document = sub {
1975 my (@path) = @_; 2164 my (@path) = @_;
1976 2165
1977 push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = (); 2166 push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
1978 2167
1979 $load_node->((dc::Pod::find @path)[0]); 2168 $load_node->((DC::Pod::find @path)[0]);
1980 $win->show; 2169 $win->show;
1981 }; 2170 };
1982 2171
1983 $win 2172 $win
1984} 2173}
1985 2174
1986sub open_string_query {
1987 my ($title, $cb, $txt, $tooltip) = @_;
1988 my $dialog = new dc::UI::Toplevel
1989 x => "center",
1990 y => "center",
1991 z => 50,
1992 force_w => $WIDTH * 4/5,
1993 title => $title;
1994
1995 $dialog->add (
1996 my $e = new dc::UI::Entry
1997 on_activate => sub { $cb->(@_); $dialog->hide; 0 },
1998 on_key_down => sub { $_[1]->{sym} == 27 and $dialog->hide; 0 },
1999 tooltip => $tooltip
2000 );
2001
2002 $e->grab_focus;
2003 $e->set_text ($txt) if $txt;
2004 $dialog->show;
2005}
2006
2007sub open_quit_dialog { 2175sub open_quit_dialog {
2008 unless ($QUIT_DIALOG) { 2176 unless ($QUIT_DIALOG) {
2009 $QUIT_DIALOG = new dc::UI::Toplevel 2177 $QUIT_DIALOG = new DC::UI::Toplevel
2010 x => "center", 2178 x => "center",
2011 y => "center", 2179 y => "center",
2012 z => 50, 2180 z => 50,
2013 title => "Really Quit?", 2181 title => "Really Quit?",
2014 on_key_down => sub { 2182 on_key_down => sub {
2015 my ($dialog, $ev) = @_; 2183 my ($dialog, $ev) = @_;
2016 $ev->{sym} == 27 and $dialog->hide; 2184 $ev->{sym} == 27 and $dialog->hide;
2017 } 2185 }
2018 ; 2186 ;
2019 2187
2020 $QUIT_DIALOG->add (my $vb = new dc::UI::VBox expand => 1); 2188 $QUIT_DIALOG->add (my $vb = new DC::UI::VBox expand => 1);
2021 2189
2022 $vb->add (new dc::UI::Label 2190 $vb->add (new DC::UI::Label
2023 text => "You should find a savebed and apply it first!", 2191 text => "You should find a savebed and apply it first!",
2024 max_w => $WIDTH * 0.25, 2192 max_w => $WIDTH * 0.25,
2025 ellipsize => 0, 2193 ellipsize => 0,
2026 ); 2194 );
2027 $vb->add (my $hb = new dc::UI::HBox expand => 1); 2195 $vb->add (my $hb = new DC::UI::HBox expand => 1);
2028 $hb->add (new dc::UI::Button 2196 $hb->add (new DC::UI::Button
2029 text => "Ok", 2197 text => "Ok",
2030 expand => 1, 2198 expand => 1,
2031 on_activate => sub { $QUIT_DIALOG->hide; 0 }, 2199 on_activate => sub { $QUIT_DIALOG->hide; 0 },
2032 ); 2200 );
2033 $hb->add (new dc::UI::Button 2201 $hb->add (new DC::UI::Button
2034 text => "Quit anyway", 2202 text => "Quit anyway",
2035 expand => 1, 2203 expand => 1,
2036 on_activate => sub { EV::unloop EV::UNLOOP_ALL }, 2204 on_activate => sub {
2205 crash "Quit anyway";
2206 EV::unloop EV::UNLOOP_ALL;
2207 },
2037 ); 2208 );
2038 } 2209 }
2039 2210
2040 $QUIT_DIALOG->show; 2211 $QUIT_DIALOG->show;
2041 $QUIT_DIALOG->grab_focus; 2212 $QUIT_DIALOG->grab_focus;
2042} 2213}
2043 2214
2215sub make_menuframe {
2216 $MENUFRAME = new DC::UI::Toplevel
2217 border => 0,
2218 force_x => 0,
2219 force_y => 0,
2220 force_w => $::WIDTH,
2221 child => ($MENUBAR = new DC::UI::HBox),
2222 ;
2223
2224 $MENUBAR->add ($BUTTONBAR = new DC::UI::Buttonbar);
2225
2226 # 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
2227 make_gauge_window->show;
2228
2229# $BUTTONBAR->add (new DC::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW,
2230# tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
2231
2232 make_playerbook;
2233
2234 $MENUPOPUP = DC::UI::Menu->new (items => [
2235 ["Setup…" , sub { $SETUP_DIALOG->toggle_visibility}],
2236 ["Playerbook…\tTab", sub { $PL_WINDOW ->toggle_visibility}],
2237 ["Help Browser…" , sub { $HELP_WINDOW ->toggle_visibility}],
2238 ["Quit…" , sub {
2239 if ($CONN) {
2240 open_quit_dialog;
2241 } else {
2242 EV::unloop EV::UNLOOP_ALL;
2243 }
2244 }],
2245 ]);
2246
2247 $BUTTONBAR->add (new DC::UI::Button text => "Menu…",
2248 tooltip => "Shows the main menu",
2249 on_button_down => sub { $MENUPOPUP->popup ($_[1]) },
2250 );
2251
2252 $MENUBAR->add ($GAUGES->{prg} = new DC::UI::ExperienceProgress
2253 c_rescale => 1,
2254 padding_x => 6,
2255 padding_y => 3,
2256 force_w => $::WIDTH * 0.1,
2257 tooltip => "This progress bar shows your progress towards the next character level.",
2258 );
2259 $MENUBAR->add ($GAUGES->{exp} = new DC::UI::Label
2260 align => 1, can_hover => 1, can_events => 1,
2261 text => "Total Experience",
2262 tooltip => "#stat_exp",
2263 fontsize => 0.8,
2264 );
2265 $MENUBAR->add ($GAUGES->{sklprg} = new DC::UI::ExperienceProgress
2266 c_rescale => 1,
2267 padding_x => 6,
2268 padding_y => 3,
2269 force_w => $::WIDTH * 0.2,
2270 tooltip => "This progress bar shows the currently used skill and your progress towards the next skill level of that skill.",
2271 );
2272 $MENUBAR->add ($GAUGES->{range} = new DC::UI::Label
2273 expand => 1,
2274 align => 1, can_hover => 1, can_events => 1,
2275 text => "Range and Combat Slots",
2276 tooltip => "#stat_ranged",
2277 );
2278
2279 $MENUFRAME->show;
2280}
2281
2282sub open_string_query {
2283 my ($title, $cb, $txt, $tooltip) = @_;
2284 my $dialog = new DC::UI::Toplevel
2285 x => "center",
2286 y => "center",
2287 z => 50,
2288 force_w => $WIDTH * 4/5,
2289 title => $title;
2290
2291 $dialog->add (
2292 my $e = new DC::UI::Entry
2293 on_activate => sub { $cb->(@_); $dialog->hide; 0 },
2294 on_key_down => sub { $_[1]->{sym} == 27 and $dialog->hide; 0 },
2295 tooltip => $tooltip
2296 );
2297
2298 $e->grab_focus;
2299 $e->set_text ($txt) if $txt;
2300 $dialog->show;
2301}
2302
2044sub show_tip_of_the_day { 2303sub show_tip_of_the_day {
2045 # find all tips 2304 # find all tips
2046 my @tod = dc::Pod::find tip_of_the_day => "*"; 2305 my @tod = DC::Pod::find tip_of_the_day => "*";
2047 2306
2048 dc::DB::get state => "tip_of_the_day", sub { 2307 DC::DB::get state => "tip_of_the_day", sub {
2049 my ($todindex) = @_; 2308 my ($todindex) = @_;
2050 $todindex = 0 if $todindex >= @tod; 2309 $todindex = 0 if $todindex >= @tod;
2051 dc::DB::put state => tip_of_the_day => $todindex + 1, sub { }; 2310 DC::DB::put state => tip_of_the_day => $todindex + 1, sub { };
2052 2311
2053 # create dialog 2312 # create dialog
2054 my $dialog; 2313 my $dialog;
2055 2314
2056 my $close = sub { 2315 my $close = sub {
2057 $dialog->destroy; 2316 $dialog->destroy;
2058 }; 2317 };
2059 2318
2060 $dialog = new dc::UI::Toplevel 2319 $dialog = new DC::UI::Toplevel
2061 x => "center", 2320 x => "center",
2062 y => "center", 2321 y => "center",
2063 z => 3, 2322 z => 3,
2064 name => 'tip_of_the_day', 2323 name => 'tip_of_the_day',
2065 force_w => int $WIDTH * 4/9, 2324 force_w => int $WIDTH * 4/9,
2066 force_h => int $WIDTH * 2/9, 2325 force_h => int $WIDTH * 2/9,
2067 title => "Tip of the day #" . (1 + $todindex), 2326 title => "Tip of the day #" . (1 + $todindex),
2068 child => my $vbox = new dc::UI::VBox, 2327 child => my $vbox = new DC::UI::VBox,
2069 has_close_button => 1, 2328 has_close_button => 1,
2070 on_delete => $close, 2329 on_delete => $close,
2071 ; 2330 ;
2072 2331
2073 $vbox->add (my $viewer = new dc::UI::TextScroller 2332 $vbox->add (my $viewer = new DC::UI::TextScroller
2074 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4); 2333 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
2075 $viewer->add_paragraph (dc::Pod::as_paragraphs dc::Pod::section_of $tod[$todindex]); 2334 $viewer->add_paragraph (DC::Pod::as_paragraphs DC::Pod::section_of $tod[$todindex]);
2076 2335
2077 $vbox->add (my $table = new dc::UI::Table col_expand => [0, 1]); 2336 $vbox->add (my $table = new DC::UI::Table col_expand => [0, 1]);
2078 2337
2079 $table->add_at (0, 0, new dc::UI::Button 2338 $table->add_at (0, 0, new DC::UI::Button
2080 text => "Close", 2339 text => "Close",
2081 tooltip => "Close the tip of the day window. To never see it again, disable the tip of the day in the <b>Server Setup</b>.", 2340 tooltip => "Close the tip of the day window. To never see it again, disable the tip of the day in the <b>Server Setup</b>.",
2082 on_activate => $close, 2341 on_activate => $close,
2083 ); 2342 );
2084 2343
2085 $table->add_at (2, 0, new dc::UI::Button 2344 $table->add_at (2, 0, new DC::UI::Button
2086 text => "Next", 2345 text => "Next",
2087 tooltip => "Show the next <b>Tip of the day</b>.", 2346 tooltip => "Show the next <b>Tip of the day</b>.",
2088 on_activate => sub { 2347 on_activate => sub {
2089 $close->(); 2348 $close->();
2090 &show_tip_of_the_day; 2349 &show_tip_of_the_day;
2094 $dialog->show; 2353 $dialog->show;
2095 }; 2354 };
2096} 2355}
2097 2356
2098sub sdl_init { 2357sub sdl_init {
2099 dc::SDL_Init 2358 DC::SDL_Init DC::SDL_INIT_AUDIO #| DC::SDL_NOPARACHUTE
2100 and die "SDL::Init failed!\n"; 2359 and die "SDL::Init failed!\n";
2101} 2360}
2102 2361
2103sub video_init { 2362sub video_init {
2363 DC::set_theme $CFG->{uitheme};
2364
2365 DC::SDL_InitSubSystem DC::SDL_INIT_VIDEO if $SDL_REINIT;
2366 $SDL_REINIT = 0;
2367
2368 @SDL_MODES = DC::SDL_ListModes 8, $CFG->{disable_alpha} ? 0 : 8;
2369 @SDL_MODES = DC::SDL_ListModes 8, 8 unless @SDL_MODES;
2370 @SDL_MODES = DC::SDL_ListModes 5, 0 unless @SDL_MODES;
2371 @SDL_MODES or DC::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
2372
2373 @SDL_MODES = sort { $a->[0] * $a->[1] <=> $b->[0] * $b->[1] } @SDL_MODES;
2374
2104 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES; 2375 if (!defined $CFG->{sdl_mode} or $CFG->{sdl_mode} > $#SDL_MODES) {
2376 $CFG->{sdl_mode} = 0; # lowest resolution by default
2377
2378 # now choose biggest mode <= 1024x768
2379 for (0 .. $#SDL_MODES) {
2380 if ($SDL_MODES[$_][0] * $SDL_MODES[$_][1] <= 1024 * 768) {
2381 $CFG->{sdl_mode} = $_;
2382 }
2383 }
2384 }
2105 2385
2106 my ($old_w, $old_h) = ($WIDTH, $HEIGHT); 2386 my ($old_w, $old_h) = ($WIDTH, $HEIGHT);
2107 2387
2108 ($WIDTH, $HEIGHT, my ($rgb, $alpha)) = @{ $SDL_MODES[$CFG->{sdl_mode}] }; 2388 ($WIDTH, $HEIGHT, my ($rgb, $alpha)) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
2109 $FULLSCREEN = $CFG->{fullscreen}; 2389 $FULLSCREEN = $CFG->{fullscreen};
2110 $FAST = $CFG->{fast}; 2390 $FAST = $CFG->{fast};
2111 2391
2392 # due to mac os x braindamage, we simply retry with !fullscreen in case of an error
2112 dc::SDL_SetVideoMode $WIDTH, $HEIGHT, $rgb, $alpha, $FULLSCREEN 2393 DC::SDL_SetVideoMode $WIDTH, $HEIGHT, $rgb, $alpha, $FULLSCREEN
2394 or DC::SDL_SetVideoMode $WIDTH, $HEIGHT, $rgb, $alpha, !$FULLSCREEN
2113 or die "SDL_SetVideoMode failed: " . (dc::SDL_GetError) . "\n"; 2395 or die "SDL_SetVideoMode failed: " . (DC::SDL_GetError) . "\n";
2114 2396
2115 $SDL_ACTIVE = 1; 2397 $SDL_ACTIVE = 1;
2116 $LAST_REFRESH = time - 0.01; 2398 $LAST_REFRESH = time - 0.01;
2117 2399
2118 dc::OpenGL::init; 2400 DC::OpenGL::init;
2119 dc::Macro::init; 2401 DC::Macro::init;
2120 2402
2121 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize}; 2403 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
2122 2404
2123 $dc::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d# 2405 $DC::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
2124 2406
2125 ############################################################################# 2407 #############################################################################
2126 2408
2127 if ($DEBUG_STATUS) { 2409 if ($DEBUG_STATUS) {
2128 dc::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h; 2410 DC::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
2129 } else { 2411 } else {
2130 # create/configure the widgets 2412 # create/configure the widgets
2131 2413
2132 $dc::UI::ROOT->connect (key_down => sub { 2414 $DC::UI::ROOT->connect (key_down => sub {
2133 my (undef, $ev) = @_; 2415 my (undef, $ev) = @_;
2134 2416
2135 if (my @macros = dc::Macro::find $ev) { 2417 if (my @macros = DC::Macro::find $ev) {
2136 dc::Macro::execute $_ for @macros; 2418 DC::Macro::execute $_ for @macros;
2137 2419
2138 return 1; 2420 return 1;
2139 } 2421 }
2140 2422
2141 0 2423 0
2142 }); 2424 });
2143 2425
2144 $DEBUG_STATUS = new dc::UI::Label 2426 $DEBUG_STATUS = new DC::UI::Label
2145 padding => 0, 2427 padding => 0,
2146 z => 100, 2428 z => 100,
2147 force_x => "max", 2429 force_x => "max",
2148 force_y => 0; 2430 force_y => 0;
2149 $DEBUG_STATUS->show; 2431 $DEBUG_STATUS->show;
2150 2432
2151 $STATUSBOX = new dc::UI::Statusbox; 2433 $STATUSBOX = new DC::UI::Statusbox;
2152 $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);
2153 2434
2435 $MODBOX = new DC::UI::Label
2436 can_events => 1,
2437 can_hover => 1,
2438 markup => "",
2439 align => 0,
2440 font => $FONT_FIXED,
2441 tooltip => "#modifier_box",
2442 tooltip_width => 0.67,
2443 ;
2444
2445 update_modbox;
2446
2154 (new dc::UI::Frame 2447 (new DC::UI::Frame
2155 bg => [0, 0, 0, 0.4], 2448 bg => [0, 0, 0, 0.4],
2156 force_x => 0, 2449 force_x => 0,
2157 force_y => "max", 2450 force_y => "max",
2158 child => $STATUSBOX, 2451 child => (my $LL = new DC::UI::VBox),
2159 )->show; 2452 )->show;
2160 2453
2454 $LL->add ($STATUSBOX);
2455 $LL->add ($MODBOX);
2456 $LL->add (new DC::UI::Label
2457 align => 0,
2458 markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode",
2459 fontsize => 0.5,
2460 fg => [1, 1, 0, 0.7],
2461 );
2462
2161 dc::UI::Toplevel->new ( 2463 DC::UI::Toplevel->new (
2162 title => "Minimap", 2464 title => "Minimap",
2163 name => "mapmap", 2465 name => "mapmap",
2164 x => 0, 2466 x => 0,
2165 y => $FONTSIZE + 8, 2467 y => $FONTSIZE + 8,
2166 border_bg => [1, 1, 1, 192/255], 2468 border_bg => [1, 1, 1, 192/255],
2167 bg => [1, 1, 1, 0], 2469 bg => [1, 1, 1, 0],
2168 child => ($MAPMAP = new dc::MapWidget::MapMap 2470 child => ($MAPMAP = new DC::MapWidget::MapMap
2169 tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.", 2471 tooltip => "<b>Minimap</b>. This will display an overview of the surrounding areas.",
2170 ), 2472 ),
2171 )->show; 2473 )->show;
2172 2474
2173 $MAPWIDGET = new dc::MapWidget; 2475 $MAPWIDGET = new DC::MapWidget;
2174 $MAPWIDGET->connect (activate_console => sub { 2476 $MAPWIDGET->connect (activate_console => sub {
2175 my ($mapwidget, $preset) = @_; 2477 my ($mapwidget, $preset) = @_;
2176 2478
2177 $MESSAGE_WINDOW->activate_console ($preset) 2479 $MESSAGE_DIST->activate_console ($preset)
2178 if $MESSAGE_WINDOW; 2480 if $MESSAGE_DIST;
2179 }); 2481 });
2180 $MAPWIDGET->show; 2482 $MAPWIDGET->show;
2181 $MAPWIDGET->grab_focus; 2483 $MAPWIDGET->grab_focus;
2182 2484
2183 $COMPLETER = new dc::MapWidget::Command:: 2485 $COMPLETER = new DC::MapWidget::Command::
2184 command => { }, 2486 command => { },
2185 tooltip => "#completer_help", 2487 tooltip => "#completer_help",
2186 ; 2488 ;
2187 2489
2188 $SETUP_DIALOG = new dc::UI::Toplevel 2490 $SETUP_DIALOG = new DC::UI::Toplevel
2189 title => "Setup", 2491 title => "Setup",
2190 name => "setup_dialog", 2492 name => "setup_dialog",
2191 x => 'center', 2493 x => 'center',
2192 y => 'center', 2494 y => 'center',
2193 z => 2, 2495 z => 2,
2195 force_h => $::HEIGHT * 0.6, 2497 force_h => $::HEIGHT * 0.6,
2196 has_close_button => 1, 2498 has_close_button => 1,
2197 ; 2499 ;
2198 2500
2199 $METASERVER = metaserver_dialog; 2501 $METASERVER = metaserver_dialog;
2200 $MESSAGE_WINDOW = new dc::UI::MessageWindow; 2502 # the name is changed to not conflict with the older name as users could have hidden it
2503 $MESSAGE_WINDOW = new DC::UI::Dockbar
2504 name => "message_window2",
2505 title => 'Messages',
2506 force_w => $::WIDTH * 0.6,
2507 force_h => $::HEIGHT * 0.25,
2508 ;
2201 2509
2510 $MESSAGE_DIST = new DC::MessageDistributor dockbar => $MESSAGE_WINDOW;
2511
2202 $SETUP_DIALOG->add ($SETUP_NOTEBOOK = new dc::UI::Notebook expand => 1, debug => 1, 2512 $SETUP_DIALOG->add ($SETUP_NOTEBOOK = new DC::UI::Notebook expand => 1,
2203 filter => new dc::UI::ScrolledWindow expand => 1, scroll_y => 1); 2513 filter => new DC::UI::ScrolledWindow expand => 1, scroll_y => 1);
2204 2514
2205 $SETUP_NOTEBOOK->add_tab (Login => $SETUP_LOGIN = login_setup, 2515 $SETUP_NOTEBOOK->add_tab (Login => $SETUP_LOGIN = login_setup,
2206 "Configure the server to play on, your username and password."); 2516 "Configure the server to play on, your username and password.");
2207 $SETUP_NOTEBOOK->add_tab (Server => $SETUP_SERVER = server_setup, 2517 $SETUP_NOTEBOOK->add_tab (Server => $SETUP_SERVER = server_setup,
2208 "Configure other server related options."); 2518 "Configure other server related options.");
2220 . "After pressing the combo the binding will be saved automatically and the " 2530 . "After pressing the combo the binding will be saved automatically and the "
2221 . "binding editor closes"); 2531 . "binding editor closes");
2222 $SETUP_NOTEBOOK->add_tab (Debug => debug_setup, 2532 $SETUP_NOTEBOOK->add_tab (Debug => debug_setup,
2223 "Some debuggin' options. Do not ask."); 2533 "Some debuggin' options. Do not ask.");
2224 2534
2225 $BUTTONBAR = new dc::UI::Buttonbar x => 0, y => 0, z => 200; # put on top 2535 make_menuframe;
2226 2536
2227 $BUTTONBAR->add (new dc::UI::Flopper text => "Setup", other => $SETUP_DIALOG,
2228 tooltip => "Toggles a dialog where you can configure all aspects of this client.");
2229
2230 $BUTTONBAR->add (new dc::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW,
2231 tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
2232
2233 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
2234
2235 $BUTTONBAR->add (new dc::UI::Flopper text => "Playerbook", other => player_window,
2236 tooltip => "Toggles the player view, where you can manage Inventory, Spells, Skills and see your Stats.");
2237
2238 $BUTTONBAR->add (new dc::UI::Button
2239 text => "Save Config",
2240 tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
2241 on_activate => sub {
2242 $::CFG->{layout} = dc::UI::get_layout;
2243 dc::write_cfg "$Deliantra::VARDIR/client.cf";
2244 status "Configuration Saved";
2245 0
2246 },
2247 );
2248
2249 $BUTTONBAR->add (new dc::UI::Flopper text => "Help!", other => $HELP_WINDOW = help_window,
2250 tooltip => "View Documentation");
2251
2252
2253 $BUTTONBAR->add (new dc::UI::Button
2254 text => "Quit",
2255 tooltip => "Terminates the program",
2256 on_activate => sub {
2257 if ($CONN) {
2258 open_quit_dialog;
2259 } else {
2260 EV::unloop EV::UNLOOP_ALL;
2261 }
2262 0
2263 },
2264 );
2265
2266 $BUTTONBAR->show;
2267 $SETUP_DIALOG->show; 2537 $SETUP_DIALOG->show;
2268 $MESSAGE_WINDOW->show; 2538 $MESSAGE_WINDOW->show;
2269 } 2539 }
2270 2540
2541 $MODE_SLIDER->set_range ([$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1, 1]);
2542 $MODE_SLIDER->emit (changed => $CFG->{sdl_mode});
2543
2544 $CAVEAT_LABEL->set_text ("None :)");
2545 $CAVEAT_LABEL->set_text ("Software Rendering (very slow)")
2546 unless DC::SDL_GL_GetAttribute DC::SDL_GL_ACCELERATED_VISUAL;
2547
2271 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]); 2548 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
2272} 2549}
2273 2550
2274sub video_shutdown { 2551sub video_shutdown {
2275 dc::OpenGL::shutdown; 2552 DC::OpenGL::shutdown;
2553 DC::SDL_QuitSubSystem DC::SDL_INIT_VIDEO if $SDL_REINIT;
2276 2554
2277 undef $SDL_ACTIVE; 2555 undef $SDL_ACTIVE;
2278} 2556}
2279 2557
2280my %animate_object; 2558my %animate_object;
2289 } 2567 }
2290 2568
2291 undef $WANT_REFRESH; 2569 undef $WANT_REFRESH;
2292 $_[0]->stop; 2570 $_[0]->stop;
2293 2571
2294 $dc::UI::ROOT->draw; 2572 $DC::UI::ROOT->draw;
2295 dc::SDL_GL_SwapBuffers; 2573 DC::SDL_GL_SwapBuffers;
2296 $LAST_REFRESH = $NOW; 2574 $LAST_REFRESH = $NOW;
2297} 2575}
2298 2576
2299my $want_refresh = EV::idle_ns \&force_refresh; 2577my $want_refresh = EV::prepare_ns \&force_refresh;
2300 2578
2301my $input = EV::periodic 0, 1/60, undef, sub { 2579my $input = EV::periodic 0, 1 / $MAX_FPS, undef, sub {
2302 $NOW = time; 2580 $NOW = EV::now;
2303 2581
2304 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_) 2582 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
2305 for dc::poll_events; 2583 for DC::poll_events;
2306 2584
2307 if (%animate_object) { 2585 if (%animate_object) {
2308 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object; 2586 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
2309 $WANT_REFRESH = 1; 2587 $WANT_REFRESH = 1;
2310 } 2588 }
2322 my ($widget) = @_; 2600 my ($widget) = @_;
2323 delete $animate_object{$widget}; 2601 delete $animate_object{$widget};
2324} 2602}
2325 2603
2326%SDL_CB = ( 2604%SDL_CB = (
2327 dc::SDL_QUIT => sub { 2605 DC::SDL_QUIT => sub {
2606 crash "SDL_QUIT";
2328 EV::unloop EV::UNLOOP_ALL; 2607 EV::unloop EV::UNLOOP_ALL;
2329 }, 2608 },
2330 dc::SDL_VIDEORESIZE => sub { 2609 DC::SDL_VIDEORESIZE => sub {
2331 }, 2610 },
2332 dc::SDL_VIDEOEXPOSE => sub { 2611 DC::SDL_VIDEOEXPOSE => sub {
2333 dc::UI::full_refresh; 2612 DC::UI::full_refresh;
2334 }, 2613 },
2335 dc::SDL_ACTIVEEVENT => sub { 2614 DC::SDL_ACTIVEEVENT => sub {
2336# not useful, as APPACTIVE includes only iconified state, not unmapped 2615# not useful, as APPACTIVE includes only iconified state, not unmapped
2337# printf "active %x %x %x\n", $_[0]{gain}, $_[0]{state}, dc::SDL_GetAppState;#d# 2616# printf "active %x %x %x\n", $_[0]{gain}, $_[0]{state}, DC::SDL_GetAppState;#d#
2338# printf "a %x\n", dc::SDL_GetAppState & dc::SDL_APPACTIVE;#d# 2617# printf "a %x\n", DC::SDL_GetAppState & DC::SDL_APPACTIVE;#d#
2339# printf "A\n" if $_[0]{state} & dc::SDL_APPACTIVE; 2618# printf "A\n" if $_[0]{state} & DC::SDL_APPACTIVE;
2340# printf "K\n" if $_[0]{state} & dc::SDL_APPINPUTFOCUS; 2619# printf "K\n" if $_[0]{state} & DC::SDL_APPINPUTFOCUS;
2341# printf "M\n" if $_[0]{state} & dc::SDL_APPMOUSEFOCUS; 2620# printf "M\n" if $_[0]{state} & DC::SDL_APPMOUSEFOCUS;
2342 }, 2621 },
2343 dc::SDL_KEYDOWN => sub { 2622 DC::SDL_KEYDOWN => sub {
2344 if ($_[0]{mod} & dc::KMOD_ALT && $_[0]{sym} == 13) { 2623 if ($_[0]{mod} & DC::KMOD_ALT && $_[0]{sym} == 13) {
2345 # alt-enter 2624 # alt-enter
2625 video_shutdown;
2346 $FULLSCREEN_ENABLE->toggle; 2626 $FULLSCREEN_ENABLE->toggle;
2347 video_shutdown;
2348 video_init; 2627 video_init;
2349 } else { 2628 } else {
2350 dc::UI::feed_sdl_key_down_event ($_[0]); 2629 &DC::UI::feed_sdl_key_down_event;
2351 } 2630 }
2631 update_modbox;
2352 }, 2632 },
2353 dc::SDL_KEYUP => \&dc::UI::feed_sdl_key_up_event, 2633 DC::SDL_KEYUP => sub {
2634 &DC::UI::feed_sdl_key_up_event;
2635 update_modbox;
2636 },
2354 dc::SDL_MOUSEMOTION => \&dc::UI::feed_sdl_motion_event, 2637 DC::SDL_MOUSEMOTION => \&DC::UI::feed_sdl_motion_event,
2355 dc::SDL_MOUSEBUTTONDOWN => \&dc::UI::feed_sdl_button_down_event, 2638 DC::SDL_MOUSEBUTTONDOWN => \&DC::UI::feed_sdl_button_down_event,
2356 dc::SDL_MOUSEBUTTONUP => \&dc::UI::feed_sdl_button_up_event, 2639 DC::SDL_MOUSEBUTTONUP => \&DC::UI::feed_sdl_button_up_event,
2357 dc::SDL_USEREVENT => sub { 2640 DC::SDL_USEREVENT => sub {
2358 if ($_[0]{code} == 1) { 2641 if ($_[0]{code} == 1) {
2359 audio_channel_finished $_[0]{data1}; 2642 audio_channel_finished $_[0]{data1};
2360 } elsif ($_[0]{code} == 0) { 2643 } elsif ($_[0]{code} == 0) {
2361 audio_music_finished; 2644 audio_music_finished;
2362 } 2645 }
2368$SIG{INT} = $SIG{TERM} = sub { 2651$SIG{INT} = $SIG{TERM} = sub {
2369 EV::unloop; 2652 EV::unloop;
2370 #d# TODO calling exit here hangs the process in some futex 2653 #d# TODO calling exit here hangs the process in some futex
2371}; 2654};
2372 2655
2373{ 2656# due to mac os x + sdl combined braindamage, we need this contortion
2657sub main {
2658 {
2659 DC::Pod::load_docwiki DC::find_rcfile "docwiki.pst";
2660
2374 if (-e "$Deliantra::VARDIR/client.cf") { 2661 if (-e "$Deliantra::VARDIR/client.cf") {
2375 dc::read_cfg "$Deliantra::VARDIR/client.cf"; 2662 DC::read_cfg "$Deliantra::VARDIR/client.cf";
2376 } else { 2663 } else {
2377 #TODO: compatibility cruft 2664 #TODO: compatibility cruft
2378 dc::read_cfg "$Deliantra::OLDDIR/cfplusrc"; 2665 DC::read_cfg "$Deliantra::OLDDIR/cfplusrc";
2379 print STDERR "INFO: used old configuratrion file\n"; 2666 print STDERR "INFO: used old configuration file\n";
2380 } 2667 }
2381 2668
2382 dc::DB::Server::run; 2669 DC::DB::Server::run;
2383 2670
2671 if ($CFG->{db_schema} < 1) {
2672 warn "INFO: upgrading database schema from 0 to 1, mapcache and tilecache will be lost\n";
2673 DC::DB::nuke_db;
2674 $CFG->{db_schema} = 1;
2675 DC::write_cfg;
2676 }
2677
2678 DC::DB::open_db;
2679
2384 dc::UI::set_layout ($::CFG->{layout}); 2680 DC::UI::set_layout ($::CFG->{layout});
2385 2681
2386 my %DEF_CFG = ( 2682 my %DEF_CFG = (
2683 config_autosave => 1,
2387 sdl_mode => 0, 2684 sdl_mode => undef,
2388 fullscreen => 1, 2685 fullscreen => 1,
2389 fast => 0, 2686 fast => 0,
2390 force_opengl11 => undef, 2687 force_opengl11 => undef,
2688 disable_alpha => 0,
2689 smooth_movement => 1,
2391 texture_compression => 1, 2690 texture_compression => 1,
2392 map_scale => 1, 2691 map_scale => 1,
2393 fow_enable => 1, 2692 fow_enable => 1,
2394 fow_intensity => 0, 2693 fow_intensity => 0,
2395 map_smoothing => 1, 2694 map_smoothing => 1,
2396 gui_fontsize => 1, 2695 gui_fontsize => 1,
2397 log_fontsize => 0.7, 2696 log_fontsize => 0.7,
2398 gauge_fontsize => 1, 2697 gauge_fontsize => 1,
2399 gauge_size => 0.35, 2698 gauge_size => 0.35,
2400 stat_fontsize => 0.7, 2699 stat_fontsize => 0.7,
2401 mapsize => 100, 2700 mapsize => 100,
2402 audio_enable => 1, 2701 audio_enable => 1,
2403 audio_hw_channels => 0, 2702 audio_hw_channels => 0,
2404 audio_hw_frequency => 0, 2703 audio_hw_frequency => 0,
2405 audio_hw_chunksize => 0, 2704 audio_hw_chunksize => 0,
2406 audio_mix_channels => 8, 2705 audio_mix_channels => 8,
2407 effects_enable => 1, 2706 effects_enable => 1,
2408 effects_volume => 1, 2707 effects_volume => 1,
2409 bgm_enable => 1, 2708 bgm_enable => 1,
2410 bgm_volume => 0.5, 2709 bgm_volume => 0.5,
2411 output_rate => "", 2710 output_rate => "",
2412 pickup => 0, 2711 pickup => 0,
2413 inv_sort => "mtime", 2712 inv_sort => "mtime",
2414 default => "profile", # default profile 2713 default => "profile", # default profile
2415 show_tips => 1, 2714 show_tips => 1,
2416 logview_max_par => 1000, 2715 logview_max_par => 1000,
2716 shift_fire_stop => 0,
2717 uitheme => "wood",
2417 ); 2718 );
2418 2719
2419 while (my ($k, $v) = each %DEF_CFG) { 2720 while (my ($k, $v) = each %DEF_CFG) {
2420 $CFG->{$k} = $v unless exists $CFG->{$k}; 2721 $CFG->{$k} = $v unless exists $CFG->{$k};
2421 } 2722 }
2422 2723
2423 $CFG->{profile}{default}{host} ||= "gameserver.deliantra.net"; 2724 $CFG->{profile}{default}{host} ||= "gameserver.deliantra.net";
2424 $PROFILE = $CFG->{profile}{default}; 2725 $PROFILE = $CFG->{profile}{default};
2425 2726
2426 # convert old bindings (only default profile matters) 2727 # convert old bindings (only default profile matters)
2427 if (my $bindings = delete $PROFILE->{bindings}) { 2728 if (my $bindings = delete $PROFILE->{bindings}) {
2428 while (my ($mod, $syms) = each %$bindings) { 2729 while (my ($mod, $syms) = each %$bindings) {
2429 while (my ($sym, $cmds) = each %$syms) { 2730 while (my ($sym, $cmds) = each %$syms) {
2430 push @{ $PROFILE->{macro} }, { 2731 push @{ $PROFILE->{macro} }, {
2431 accelkey => [$mod*1, $sym*1], 2732 accelkey => [$mod*1, $sym*1],
2432 action => $cmds, 2733 action => $cmds,
2734 };
2433 }; 2735 }
2434 } 2736 }
2435 } 2737 }
2436 }
2437 2738
2438 sdl_init; 2739 sdl_init;
2439 2740
2440 @SDL_MODES = dc::SDL_ListModes 8, 8; 2741 {
2441 @SDL_MODES = dc::SDL_ListModes 5, 0 unless @SDL_MODES;
2442 @SDL_MODES or dc::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
2443
2444 @SDL_MODES = sort { $a->[0] * $a->[1] <=> $b->[0] * $b->[1] } @SDL_MODES;
2445
2446 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
2447
2448 {
2449 my @fonts = map dc::find_rcfile "fonts/$_", qw( 2742 my @fonts = map DC::find_rcfile "fonts/$_", qw(
2450 DejaVuSans.ttf 2743 DejaVuSans.ttf
2451 DejaVuSansMono.ttf 2744 DejaVuSansMono.ttf
2452 DejaVuSans-Bold.ttf 2745 DejaVuSans-Bold.ttf
2453 DejaVuSansMono-Bold.ttf 2746 DejaVuSansMono-Bold.ttf
2454 DejaVuSans-Oblique.ttf 2747 DejaVuSans-Oblique.ttf
2455 DejaVuSansMono-Oblique.ttf 2748 DejaVuSansMono-Oblique.ttf
2456 DejaVuSans-BoldOblique.ttf 2749 DejaVuSans-BoldOblique.ttf
2457 DejaVuSansMono-BoldOblique.ttf 2750 DejaVuSansMono-BoldOblique.ttf
2458 ); 2751 );
2459 2752
2460 dc::add_font $_ for @fonts; 2753 DC::add_font $_ for @fonts;
2461 2754
2462 dc::pango_init;
2463
2464 $FONT_PROP = new_from_file dc::Font $fonts[0]; 2755 $FONT_PROP = new_from_file DC::Font $fonts[0];
2465 $FONT_FIXED = new_from_file dc::Font $fonts[1]; 2756 $FONT_FIXED = new_from_file DC::Font $fonts[1];
2466 2757
2467 $FONT_PROP->make_default; 2758 $FONT_PROP->make_default;
2468 } 2759
2760 DC::pango_init;
2761 }
2469 2762
2470# compare mono (ft) vs. rgba (cairo) 2763# compare mono (ft) vs. rgba (cairo)
2471# ft - 1.8s, cairo 3s, even in alpha-only mode 2764# ft - 1.8s, cairo 3s, even in alpha-only mode
2472# for my $rgba (0..1) { 2765# for my $rgba (0..1) {
2473# my $t1 = Time::HiRes::time; 2766# my $t1 = Time::HiRes::time;
2474# for (1..1000) { 2767# for (1..1000) {
2475# my $layout = dc::Layout->new ($rgba); 2768# my $layout = DC::Layout->new ($rgba);
2476# $layout->set_text ("hallo" x 100); 2769# $layout->set_text ("hallo" x 100);
2477# $layout->render; 2770# $layout->render;
2478# } 2771# }
2479# my $t2 = Time::HiRes::time; 2772# my $t2 = Time::HiRes::time;
2480# warn $t2-$t1; 2773# warn $t2-$t1;
2481# } 2774# }
2482 2775
2483 video_init; 2776 video_init;
2484 audio_init; 2777 audio_init;
2485} 2778 }
2486 2779
2487show_tip_of_the_day if $CFG->{show_tips}; 2780 show_tip_of_the_day if $CFG->{show_tips};
2488 2781
2489our $STARTUP_CANCEL = EV::idle sub { 2782 our $STARTUP_CANCEL = EV::idle sub {
2490 undef $::STARTUP_CANCEL; 2783 undef $::STARTUP_CANCEL;
2491 $startup_done->(); 2784 $startup_done->();
2492}; 2785 };
2493 2786
2787 delete $SIG{__DIE__};
2494EV::loop; 2788 EV::loop;
2495 2789
2790 DC::write_cfg if $CFG->{config_autosave};
2791
2496#video_shutdown; 2792 #video_shutdown;
2497#audio_shutdown; 2793 #audio_shutdown;
2794
2498dc::OpenGL::quit; 2795 DC::OpenGL::quit;
2499dc::SDL_Quit; 2796 DC::SDL_Quit;
2500dc::DB::Server::stop; 2797 DC::DB::Server::stop;
2798}
2799
2800DC::SDL_braino; # see sub above
2501 2801
2502=head1 NAME 2802=head1 NAME
2503 2803
2504deliantra - A Deliantra MORPG game client 2804deliantra - A Deliantra MORPG game client
2505 2805
2522 4 show fps 2822 4 show fps
2523 8 suppress tooltips 2823 8 suppress tooltips
2524 2824
2525=head1 AUTHOR 2825=head1 AUTHOR
2526 2826
2527Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org> 2827Marc Lehmann <deliantra@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
2528 2828
2529 2829
2530 2830

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines