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