ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/deliantra
Revision: 1.108
Committed: Thu Apr 8 04:49:32 2010 UTC (14 years, 1 month ago) by root
Branch: MAIN
Changes since 1.107: +6 -2 lines
Log Message:
new version

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