ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/deliantra
Revision: 1.100
Committed: Tue Dec 22 01:37:42 2009 UTC (14 years, 5 months ago) by root
Branch: MAIN
CVS Tags: rel-2_10
Changes since 1.99: +2 -1 lines
Log Message:
bugfixes, also support ARB_multitexturing for low-end apple intel

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