ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/deliantra
Revision: 1.112
Committed: Thu Apr 22 11:18:04 2010 UTC (14 years, 1 month ago) by root
Branch: MAIN
Changes since 1.111: +5 -4 lines
Log Message:
display name of audiodriver

File Contents

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