ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/deliantra
Revision: 1.85
Committed: Sun Jan 11 03:19:47 2009 UTC (15 years, 5 months ago) by root
Branch: MAIN
Changes since 1.84: +141 -90 lines
Log Message:
*** empty log message ***

File Contents

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