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