ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/deliantra
Revision: 1.101
Committed: Thu Feb 4 20:01:09 2010 UTC (14 years, 3 months ago) by root
Branch: MAIN
Changes since 1.100: +8 -3 lines
Log Message:
*** empty log message ***

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