ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/deliantra
Revision: 1.89
Committed: Mon Jan 12 03:11:05 2009 UTC (15 years, 4 months ago) by root
Branch: MAIN
Changes since 1.88: +1 -1 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 #!/opt/bin/perl
2
3 if ($ENV{DELIANTRA_CORO_DEBUG}) {
4 eval '
5 use Coro;
6 use Coro::EV;
7 use Coro::Debug;
8 our $debug = new_unix_server Coro::Debug "/tmp/dc";
9 ';
10 }
11
12 # do splash-screen thingy on win32
13 my $startup_done = sub { };
14 BEGIN {
15 if (%PAR::LibCache && $^O eq "MSWin32") {
16 while (my ($filename, $zip) = each %PAR::LibCache) {
17 $zip->extractMember ("SPLASH.bmp", "$ENV{PAR_TEMP}/SPLASH.bmp");
18 }
19
20 require Win32::GUI::SplashScreen;
21
22 # initialise the resolver now, as vista forces us back to the desktop
23 # when doing this.
24 use AnyEvent::DNS ();
25 AnyEvent::DNS::resolver;
26
27 Win32::GUI::SplashScreen::Show (
28 -file => "$ENV{PAR_TEMP}/SPLASH.bmp",
29 );
30
31 $startup_done = sub {
32 Win32::GUI::SplashScreen::Done (1);
33 };
34 }
35 }
36
37 use 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. The name is case-sensitive!",
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 # ["Inhibit autopickup" => PICKUP_INHIBIT],
1815 ["Stop before pickup" => PICKUP_STOP],
1816 ["Debug autopickup" => PICKUP_DEBUG],
1817 ],
1818 ["Weapons", 0, 6,
1819 ["All weapons" => PICKUP_ALLWEAPON],
1820 ["Missile weapons" => PICKUP_MISSILEWEAPON],
1821 ["Bows" => PICKUP_BOW],
1822 ["Arrows" => PICKUP_ARROW],
1823 ],
1824 ["Armour", 0, 12,
1825 ["Helmets" => PICKUP_HELMET],
1826 ["Shields" => PICKUP_SHIELD],
1827 ["Body Armour" => PICKUP_ARMOUR],
1828 ["Boots" => PICKUP_BOOTS],
1829 ["Gloves" => PICKUP_GLOVES],
1830 ["Cloaks" => PICKUP_CLOAK],
1831 ],
1832
1833 ["Readables", 2, 0,
1834 ["Spellbooks" => PICKUP_SPELLBOOK],
1835 ["Skillscrolls" => PICKUP_SKILLSCROLL],
1836 ["Normal Books/Scrolls" => PICKUP_READABLES],
1837 ],
1838 ["Misc", 2, 5,
1839 ["Food" => PICKUP_FOOD],
1840 ["Drinks" => PICKUP_DRINK],
1841 ["Valuables (Money, Gems)" => PICKUP_VALUABLES],
1842 ["Keys" => PICKUP_KEY],
1843 ["Magical Items" => PICKUP_MAGICAL],
1844 ["Potions" => PICKUP_POTION],
1845 ["Magic Devices" => PICKUP_MAGIC_DEVICE],
1846 ["Ignore cursed" => PICKUP_NOT_CURSED],
1847 ["Jewelery" => PICKUP_JEWELS],
1848 ["Flesh" => PICKUP_FLESH],
1849 ],
1850 ["Value/Weight ratio", 2, 17]
1851 )
1852 {
1853 my ($title, $x, $y, @bits) = @$_;
1854 $table->add_at ($x, $y, new DC::UI::Label text => $title, align => 1, fg => [1, 1, 0]);
1855
1856 for (@bits) {
1857 ++$y;
1858
1859 my $mask = $_->[1];
1860 $table->add_at ($x , $y, new DC::UI::Label text => $_->[0], align => 1, expand => 1);
1861 $table->add_at ($x+1, $y, my $checkbox = new DC::UI::CheckBox
1862 state => $::CFG->{pickup} & $mask,
1863 on_changed => sub {
1864 my ($box, $value) = @_;
1865
1866 if ($value) {
1867 $::CFG->{pickup} |= $mask;
1868 } else {
1869 $::CFG->{pickup} &= ~$mask;
1870 }
1871
1872 $::CONN->send_pickup ($::CFG->{pickup})
1873 if defined $::CONN;
1874
1875 0
1876 });
1877
1878 ${$_->[2]} = $checkbox if $_->[2];
1879 }
1880 }
1881
1882 $table->add_at (2, 18, new DC::UI::ValSlider
1883 range => [$::CFG->{pickup} & 0xF, 0, 16, 1, 1],
1884 template => ">= 99",
1885 tooltip => "Pick up items whose value/weight (silver/kg) ratio is equal or higher than this setting (which is specified in gold coins).",
1886 to_value => sub { ">= " . 5 * $_[0] },
1887 on_changed => sub {
1888 my ($slider, $value) = @_;
1889
1890 $::CFG->{pickup} &= ~0xF;
1891 $::CFG->{pickup} |= int $value
1892 if $value;
1893 1;
1894 });
1895
1896 $table->add_at (3, 18, new DC::UI::Button
1897 text => "set",
1898 on_activate => sub {
1899 $::CONN->send_pickup ($::CFG->{pickup})
1900 if defined $::CONN;
1901 0
1902 });
1903
1904 $r
1905 }
1906
1907 my %SORT_ORDER = (
1908 type => sub {
1909 sort { $a->{type} <=> $b->{type} or $a->{name} cmp $b->{name} } @_
1910 },
1911 mtime => sub {
1912 my $NOW = time;
1913 sort {
1914 my $atime = $a->{mtime} - $NOW; $atime = $atime < 5 * 60 ? int $atime / 60 : 6;
1915 my $btime = $b->{mtime} - $NOW; $btime = $btime < 5 * 60 ? int $btime / 60 : 6;
1916
1917 ($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED)
1918 or $btime <=> $atime
1919 or $a->{type} <=> $b->{type}
1920 } @_
1921 },
1922 weight => sub { sort {
1923 $a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1)
1924 or $a->{type} <=> $b->{type}
1925 } @_ },
1926 );
1927
1928 sub inventory_widget {
1929 my $hb = new DC::UI::HBox homogeneous => 1;
1930
1931 $hb->add (my $vb1 = new DC::UI::VBox);
1932 $vb1->add (new DC::UI::Label text => "Player");
1933
1934 $vb1->add (my $hb1 = new DC::UI::HBox);
1935
1936 use sort 'stable';
1937
1938 $hb1->add (new DC::UI::Selector
1939 value => $::CFG->{inv_sort},
1940 options => [
1941 [type => "Type/Name"],
1942 [mtime => "Recent/Normal/Locked"],
1943 [weight => "Weight/Type"],
1944 ],
1945 on_changed => sub {
1946 $::CFG->{inv_sort} = $_[1];
1947 $INV->set_sort_order ($SORT_ORDER{$_[1]});
1948 },
1949 );
1950 $hb1->add (new DC::UI::Label text => "Weight: ", align => 1, expand => 1);
1951 #TODO# update to weight/maxweight
1952 $hb1->add ($STATWIDS->{i_weight} = new DC::UI::Label align => 0);
1953
1954 $vb1->add (my $sw1 = new DC::UI::ScrolledWindow expand => 1, scroll_y => 1);
1955 $sw1->add ($INV = new DC::UI::Inventory);
1956 $INV->set_sort_order ($SORT_ORDER{$::CFG->{inv_sort}});
1957
1958 $hb->add (my $vb2 = new DC::UI::VBox);
1959
1960 $vb2->add ($INVR_HB = new DC::UI::HBox);
1961
1962 $vb2->add (my $sw2 = new DC::UI::ScrolledWindow expand => 1, scroll_y => 1);
1963 $sw2->add ($INVR = new DC::UI::Inventory);
1964
1965 # XXX: Call after $INVR = ... because set_opencont sets the items
1966 DC::Protocol::set_opencont ($::CONN, 0, "Floor");
1967
1968 $hb
1969 }
1970
1971 sub media_window {
1972 my $vb = new DC::UI::VBox;
1973
1974 $vb->add (new DC::UI::FancyFrame
1975 label => "Currently playing music",
1976 child => new DC::UI::ScrolledWindow scroll_x => 1, scroll_y => 0,
1977 child => ($MUSIC_PLAYING_WIDGET = new DC::UI::Label ellipsise => 0, fontsize => 0.8),
1978 );
1979
1980 $vb->add (new DC::UI::FancyFrame
1981 label => "Other media used in this session",
1982 expand => 1,
1983 child => ($LICENSE_WIDGET = new DC::UI::TextScroller
1984 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4),
1985 );
1986
1987 $vb
1988 }
1989
1990 sub add_license {
1991 my ($meta) = @_;
1992
1993 $meta = $meta->{data}
1994 or return;
1995
1996 $meta->{license} || $meta->{author} || $meta->{source}
1997 or return;
1998
1999 $LICENSE_WIDGET->add_paragraph ({
2000 fg => [1, 1, 1, 1],
2001 markup => "<small>"
2002 . "<b>Name:</b> " . (DC::asxml $meta->{name}) . "\n"
2003 . "<b>Author:</b> " . (DC::asxml $meta->{author}) . "\n"
2004 . "<b>Source:</b> " . (DC::asxml $meta->{source}) . "\n"
2005 . "<b>License:</b> " . (DC::asxml $meta->{license}) . "\n"
2006 . "</small>",
2007 });
2008 $LICENSE_WIDGET->scroll_to_bottom;
2009 }
2010
2011 sub toggle_player_page {
2012 my ($widget) = @_;
2013
2014 if ($PL_WINDOW->{visible} && $PL_NOTEBOOK->get_current_page == $widget) {
2015 $PL_WINDOW->hide;
2016 } else {
2017 $PL_NOTEBOOK->set_current_page ($widget);
2018 $PL_WINDOW->show;
2019 }
2020 }
2021
2022 sub make_playerbook {
2023 my $plwin = $PL_WINDOW = new DC::UI::Toplevel
2024 x => "center",
2025 y => "center",
2026 force_w => $WIDTH * 9/10,
2027 force_h => $HEIGHT * 9/10,
2028 title => "Player",
2029 name => "playerbook",
2030 has_close_button => 1
2031 ;
2032
2033 my $ntb =
2034 $PL_NOTEBOOK =
2035 new DC::UI::Notebook expand => 1;
2036
2037 $ntb->add_tab (
2038 "Statistics (F2)" => $STATS_PAGE = stats_window,
2039 "Shows statistics, where all your Stats and Resistances are shown."
2040 );
2041 $ntb->add_tab (
2042 "Skills (F3)" => $SKILL_PAGE = skill_window,
2043 "Shows all your Skills."
2044 );
2045
2046 my $spellsw = $SPELL_PAGE = new DC::UI::ScrolledWindow (expand => 1, scroll_y => 1);
2047 $spellsw->add ($SPELL_LIST = new DC::UI::SpellList);
2048 $ntb->add_tab (
2049 "Spellbook (F4)" => $spellsw,
2050 "Displays all spells you have and lets you edit keyboard shortcuts for them."
2051 );
2052 $ntb->add_tab (
2053 "Inventory (F5)" => $INVENTORY_PAGE = inventory_widget,
2054 "Toggles the inventory window, where you can manage your loot (or treasures :). "
2055 . "You can also hit the <b>Tab</b>-key to show/hide the Inventory."
2056 );
2057 $ntb->add_tab (Pickup => $PICKUP_PAGE = autopickup_setup,
2058 "Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them.");
2059
2060 $ntb->add_tab (Media => media_window,
2061 "License, Author and Source info for media sent by the server.");
2062
2063 $ntb->set_current_page ($INVENTORY_PAGE);
2064
2065 $plwin->add ($ntb);
2066 }
2067
2068 sub keyboard_setup {
2069 DC::Macro::keyboard_setup
2070 }
2071
2072 sub make_help_window {
2073 my $win = new DC::UI::Toplevel
2074 x => 'center',
2075 y => 'center',
2076 z => 4,
2077 name => 'doc_browser',
2078 force_w => int $WIDTH * 7/8,
2079 force_h => int $HEIGHT * 7/8,
2080 title => "Help Browser",
2081 has_close_button => 1;
2082
2083 $win->add (my $vbox = new DC::UI::VBox);
2084
2085 $vbox->add (new DC::UI::FancyFrame
2086 label => "Navigation",
2087 child => (my $buttons = new DC::UI::HBox),
2088 );
2089 $vbox->add (my $viewer = new DC::UI::TextScroller
2090 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
2091
2092 my @history;
2093 my @future;
2094 my $curnode;
2095
2096 my $load_node; $load_node = sub {
2097 my ($node, $para) = @_;
2098
2099 $buttons->clear;
2100
2101 $buttons->add (new DC::UI::Button
2102 text => "⇤",
2103 tooltip => "back to the starting page",
2104 on_activate => sub {
2105 unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
2106 unshift @future, @history;
2107 @history = ();
2108 $load_node->(@{shift @future});
2109 },
2110 );
2111
2112 if (@history) {
2113 $buttons->add (new DC::UI::Button
2114 text => "⋘",
2115 tooltip => "back to <i>" . (DC::asxml DC::Pod::full_path $history[-1][0]) . "</i>",
2116 on_activate => sub {
2117 unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
2118 $load_node->(@{pop @history});
2119 },
2120 );
2121 }
2122
2123 if (@future) {
2124 $buttons->add (new DC::UI::Button
2125 text => "⋙",
2126 tooltip => "forward to <i>" . (DC::asxml DC::Pod::full_path $future[0][0]) . "</i>",
2127 on_activate => sub {
2128 push @history, [$curnode, $viewer->current_paragraph];
2129 $load_node->(@{shift @future});
2130 },
2131 );
2132 }
2133
2134 $buttons->add (new DC::UI::Label text => " ");
2135
2136 my @path = DC::Pod::full_path_of $node;
2137 pop @path; # drop current node
2138
2139 for my $node (@path) {
2140 $buttons->add (new DC::UI::Button
2141 text => $node->[DC::Pod::N_KW][0],
2142 tooltip => "go to <i>" . (DC::asxml DC::Pod::full_path $node) . "</i>",
2143 on_activate => sub {
2144 push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
2145 $load_node->($node);
2146 },
2147 );
2148 $buttons->add (new DC::UI::Label text => "/");
2149 }
2150
2151 $buttons->add (new DC::UI::Label text => $node->[DC::Pod::N_KW][0], padding_x => 4, padding_y => 4);
2152
2153 $curnode = $node;
2154
2155 $viewer->clear;
2156 $viewer->add_paragraph (DC::Pod::as_paragraphs DC::Pod::section_of $curnode);
2157 $viewer->scroll_to ($para);
2158 };
2159
2160 $load_node->(DC::Pod::find pod => "mainpage");
2161
2162 $DC::Pod::goto_document = sub {
2163 my (@path) = @_;
2164
2165 push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
2166
2167 $load_node->((DC::Pod::find @path)[0]);
2168 $win->show;
2169 };
2170
2171 $HELP_WINDOW = $win;
2172 }
2173
2174 sub open_quit_dialog {
2175 unless ($QUIT_DIALOG) {
2176 $QUIT_DIALOG = new DC::UI::Toplevel
2177 x => "center",
2178 y => "center",
2179 z => 50,
2180 title => "Really Quit?",
2181 on_key_down => sub {
2182 my ($dialog, $ev) = @_;
2183 $ev->{sym} == 27 and $dialog->hide;
2184 }
2185 ;
2186
2187 $QUIT_DIALOG->add (my $vb = new DC::UI::VBox expand => 1);
2188
2189 $vb->add (new DC::UI::Label
2190 text => "You should find a savebed and apply it first!",
2191 max_w => $WIDTH * 0.25,
2192 ellipsize => 0,
2193 );
2194 $vb->add (my $hb = new DC::UI::HBox expand => 1);
2195 $hb->add (new DC::UI::Button
2196 text => "Ok",
2197 expand => 1,
2198 on_activate => sub { $QUIT_DIALOG->hide; 0 },
2199 );
2200 $hb->add (new DC::UI::Button
2201 text => "Quit anyway",
2202 expand => 1,
2203 on_activate => sub {
2204 crash "Quit anyway";
2205 EV::unloop EV::UNLOOP_ALL;
2206 },
2207 );
2208 }
2209
2210 $QUIT_DIALOG->show;
2211 $QUIT_DIALOG->grab_focus;
2212 }
2213
2214 sub make_menubar {
2215 $MENUFRAME = new DC::UI::Toplevel
2216 border => 0,
2217 force_x => 0,
2218 force_y => 0,
2219 force_w => $::WIDTH,
2220 child => ($MENUBAR = new DC::UI::HBox),
2221 ;
2222
2223 $MENUBAR->add ($BUTTONBAR = new DC::UI::Buttonbar);
2224
2225 # 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
2226 make_gauge_window->show;
2227
2228 # $BUTTONBAR->add (new DC::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW,
2229 # tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
2230
2231 make_playerbook;
2232
2233 $MENUPOPUP = DC::UI::Menu->new (items => [
2234 ["Setup…\tF9" , sub { $SETUP_DIALOG->toggle_visibility }],
2235 ["Playerbook…\tTab" , sub { $PL_WINDOW ->toggle_visibility }],
2236 ["…Statistics\tF2" , sub { toggle_player_page ($::STATS_PAGE) }],
2237 ["…Skills\tF3" , sub { toggle_player_page ($::SKILL_PAGE) }],
2238 ["…Spells\tF4" , sub { toggle_player_page ($::SPELL_PAGE) }],
2239 ["…Inventory\tF5" , sub { toggle_player_page ($::INVENTORY_PAGE) }],
2240 ["Help Browser…\tF1" , sub { $HELP_WINDOW ->toggle_visibility }],
2241 ["Quit…" , sub {
2242 if ($CONN) {
2243 open_quit_dialog;
2244 } else {
2245 EV::unloop EV::UNLOOP_ALL;
2246 }
2247 }],
2248 ]);
2249
2250 $BUTTONBAR->add (new DC::UI::Button text => "Menu…",
2251 tooltip => "Shows the main menu",
2252 on_button_down => sub {
2253 my ($self, $ev) = @_;
2254 local $ev->{x} = 0;
2255 local $ev->{y} = 0;
2256 $MENUPOPUP->popup ($ev);
2257 },
2258 );
2259
2260 $MENUBAR->add ($GAUGES->{exp} = new DC::UI::ExperienceProgress
2261 padding_x => 6,
2262 padding_y => 3,
2263 tooltip => "This progress bar shows your progress towards the next character level.",
2264 template => " Exp: 888,888,888,888 (lvl 188) ",
2265 );
2266
2267 $MENUBAR->add ($PICKUP_ENABLE = new DC::UI::CheckBox # checkbox bad, button better?
2268 tooltip => "Automatic Pickup Enable - when this checkbox is enabled, then your character "
2269 . "will automatically pick up items as defined by your item pickup settings "
2270 . "in the playerbook. Often (e.g. in apartments) you want to temporarily "
2271 . "disable autopickup by disabling this checkbox.",
2272 state => $CFG->{pickup} & PICKUP_INHIBIT ? 0 : 1,
2273 on_changed => sub {
2274 my ($self, $value) = @_;
2275 $CFG->{pickup} &= ~PICKUP_INHIBIT;
2276 $CFG->{pickup} |= PICKUP_INHIBIT unless $_[1];
2277 $CONN->send_pickup ($CFG->{pickup})
2278 if $CONN;
2279 },
2280 );
2281
2282 $MENUBAR->add ($GAUGES->{skillexp} = new DC::UI::ExperienceProgress
2283 c_rescale => 1,
2284 padding_x => 6,
2285 padding_y => 3,
2286 force_w => $::WIDTH * 0.2,
2287 tooltip => "This progress bar shows the currently used skill and your progress towards the next skill level of that skill.",
2288 template => "two handed weapons 99%",
2289 );
2290
2291 $MENUBAR->add ($GAUGES->{range} = new DC::UI::Label
2292 expand => 1,
2293 align => 1, can_hover => 1, can_events => 1,
2294 text => "Range and Combat Slots",
2295 tooltip => "#stat_ranged",
2296 );
2297
2298 $MENUFRAME->show;
2299 }
2300
2301 sub open_string_query {
2302 my ($title, $cb, $txt, $tooltip) = @_;
2303 my $dialog = new DC::UI::Toplevel
2304 x => "center",
2305 y => "center",
2306 z => 50,
2307 force_w => $WIDTH * 4/5,
2308 title => $title;
2309
2310 $dialog->add (
2311 my $e = new DC::UI::Entry
2312 on_activate => sub { $cb->(@_); $dialog->hide; 0 },
2313 on_key_down => sub { $_[1]->{sym} == 27 and $dialog->hide; 0 },
2314 tooltip => $tooltip
2315 );
2316
2317 $e->grab_focus;
2318 $e->set_text ($txt) if $txt;
2319 $dialog->show;
2320 }
2321
2322 sub show_tip_of_the_day {
2323 # find all tips
2324 my @tod = DC::Pod::find tip_of_the_day => "*";
2325
2326 DC::DB::get state => "tip_of_the_day", sub {
2327 my ($todindex) = @_;
2328 $todindex = 0 if $todindex >= @tod;
2329 DC::DB::put state => tip_of_the_day => $todindex + 1, sub { };
2330
2331 # create dialog
2332 my $dialog;
2333
2334 my $close = sub {
2335 $dialog->destroy;
2336 };
2337
2338 $dialog = new DC::UI::Toplevel
2339 x => "center",
2340 y => "center",
2341 z => 3,
2342 name => 'tip_of_the_day',
2343 force_w => int $WIDTH * 4/9,
2344 force_h => int $WIDTH * 2/9,
2345 title => "Tip of the day #" . (1 + $todindex),
2346 child => my $vbox = new DC::UI::VBox,
2347 has_close_button => 1,
2348 on_delete => $close,
2349 ;
2350
2351 $vbox->add (my $viewer = new DC::UI::TextScroller
2352 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
2353 $viewer->add_paragraph (DC::Pod::as_paragraphs DC::Pod::section_of $tod[$todindex]);
2354
2355 $vbox->add (my $table = new DC::UI::Table col_expand => [0, 1]);
2356
2357 $table->add_at (0, 0, new DC::UI::Button
2358 text => "Close",
2359 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>.",
2360 on_activate => $close,
2361 );
2362
2363 $table->add_at (2, 0, new DC::UI::Button
2364 text => "Next",
2365 tooltip => "Show the next <b>Tip of the day</b>.",
2366 on_activate => sub {
2367 $close->();
2368 &show_tip_of_the_day;
2369 },
2370 );
2371
2372 $dialog->show;
2373 };
2374 }
2375
2376 sub sdl_init {
2377 DC::SDL_Init DC::SDL_INIT_AUDIO #| DC::SDL_NOPARACHUTE
2378 and die "SDL::Init failed!\n";
2379 }
2380
2381 sub video_init {
2382 DC::set_theme $CFG->{uitheme};
2383
2384 DC::SDL_InitSubSystem DC::SDL_INIT_VIDEO if $SDL_REINIT;
2385 $SDL_REINIT = 0;
2386
2387 @SDL_MODES = DC::SDL_ListModes 8, $CFG->{disable_alpha} ? 0 : 8;
2388 @SDL_MODES = DC::SDL_ListModes 8, 8 unless @SDL_MODES;
2389 @SDL_MODES = DC::SDL_ListModes 5, 0 unless @SDL_MODES;
2390 @SDL_MODES or DC::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
2391
2392 @SDL_MODES = sort { $a->[0] * $a->[1] <=> $b->[0] * $b->[1] } @SDL_MODES;
2393
2394 if (!defined $CFG->{sdl_mode} or $CFG->{sdl_mode} > $#SDL_MODES) {
2395 $CFG->{sdl_mode} = 0; # lowest resolution by default
2396
2397 # now choose biggest mode <= 1024x768
2398 for (0 .. $#SDL_MODES) {
2399 if ($SDL_MODES[$_][0] * $SDL_MODES[$_][1] <= 1024 * 768) {
2400 $CFG->{sdl_mode} = $_;
2401 }
2402 }
2403 }
2404
2405 my ($old_w, $old_h) = ($WIDTH, $HEIGHT);
2406
2407 ($WIDTH, $HEIGHT, my ($rgb, $alpha)) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
2408 $FULLSCREEN = $CFG->{fullscreen};
2409 $FAST = $CFG->{fast};
2410
2411 # due to mac os x braindamage, we simply retry with !fullscreen in case of an error
2412 DC::SDL_SetVideoMode $WIDTH, $HEIGHT, $rgb, $alpha, $FULLSCREEN
2413 or DC::SDL_SetVideoMode $WIDTH, $HEIGHT, $rgb, $alpha, !$FULLSCREEN
2414 or die "SDL_SetVideoMode failed: " . (DC::SDL_GetError) . "\n";
2415
2416 $SDL_ACTIVE = 1;
2417 $LAST_REFRESH = time - 0.01;
2418
2419 DC::OpenGL::init;
2420 DC::Macro::init;
2421
2422 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
2423
2424 $DC::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
2425
2426 #############################################################################
2427
2428 if ($DEBUG_STATUS) {
2429 DC::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
2430 } else {
2431 # create/configure the widgets
2432
2433 $DC::UI::ROOT->connect (key_down => sub {
2434 my (undef, $ev) = @_;
2435
2436 if (my @macros = DC::Macro::find $ev) {
2437 DC::Macro::execute $_ for @macros;
2438
2439 return 1;
2440 }
2441
2442 0
2443 });
2444
2445 $DEBUG_STATUS = new DC::UI::Label
2446 padding => 0,
2447 z => 100,
2448 force_x => "max",
2449 force_y => 0;
2450 $DEBUG_STATUS->show;
2451
2452 $STATUSBOX = new DC::UI::Statusbox;
2453
2454 $MODBOX = new DC::UI::Label
2455 can_events => 1,
2456 can_hover => 1,
2457 markup => "",
2458 align => 0,
2459 font => $FONT_FIXED,
2460 tooltip => "#modifier_box",
2461 tooltip_width => 0.67,
2462 ;
2463
2464 update_modbox;
2465
2466 (new DC::UI::Frame
2467 bg => [0, 0, 0, 0.4],
2468 force_x => 0,
2469 force_y => "max",
2470 child => (my $LL = new DC::UI::VBox),
2471 )->show;
2472
2473 $LL->add ($STATUSBOX);
2474 $LL->add ($MODBOX);
2475 $LL->add (new DC::UI::Label
2476 align => 0,
2477 markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode",
2478 fontsize => 0.5,
2479 fg => [1, 1, 0, 0.7],
2480 );
2481
2482 DC::UI::Toplevel->new (
2483 title => "Minimap",
2484 name => "mapmap",
2485 x => 0,
2486 y => $FONTSIZE + 8,
2487 border_bg => [1, 1, 1, 192/255],
2488 bg => [1, 1, 1, 0],
2489 child => ($MAPMAP = new DC::MapWidget::MapMap
2490 tooltip => "<b>Minimap</b>. This will display an overview of the surrounding areas.",
2491 ),
2492 )->show;
2493
2494 $MAPWIDGET = new DC::MapWidget;
2495 $MAPWIDGET->connect (activate_console => sub {
2496 my ($mapwidget, $preset) = @_;
2497
2498 $MESSAGE_DIST->activate_console ($preset)
2499 if $MESSAGE_DIST;
2500 });
2501 $MAPWIDGET->show;
2502 $MAPWIDGET->grab_focus;
2503
2504 $COMPLETER = new DC::MapWidget::Command::
2505 command => { },
2506 tooltip => "#completer_help",
2507 ;
2508
2509 $SETUP_DIALOG = new DC::UI::Toplevel
2510 title => "Setup",
2511 name => "setup_dialog",
2512 x => 'center',
2513 y => 'center',
2514 z => 2,
2515 force_w => $::WIDTH * 0.6,
2516 force_h => $::HEIGHT * 0.6,
2517 has_close_button => 1,
2518 ;
2519
2520 $METASERVER = metaserver_dialog;
2521 # the name is changed to not conflict with the older name as users could have hidden it
2522 $MESSAGE_WINDOW = new DC::UI::Dockbar
2523 name => "message_window2",
2524 title => 'Messages',
2525 force_w => $::WIDTH * 0.6,
2526 force_h => $::HEIGHT * 0.25,
2527 ;
2528
2529 $MESSAGE_DIST = new DC::MessageDistributor dockbar => $MESSAGE_WINDOW;
2530
2531 $SETUP_DIALOG->add ($SETUP_NOTEBOOK = new DC::UI::Notebook expand => 1,
2532 filter => new DC::UI::ScrolledWindow expand => 1, scroll_y => 1);
2533
2534 $SETUP_NOTEBOOK->add_tab (Login => $SETUP_LOGIN = login_setup,
2535 "Configure the server to play on, your username and password.");
2536 $SETUP_NOTEBOOK->add_tab (Server => $SETUP_SERVER = server_setup,
2537 "Configure other server related options.");
2538 $SETUP_NOTEBOOK->add_tab (Client => client_setup,
2539 "Configure various client-specific settings.");
2540 $SETUP_NOTEBOOK->add_tab (Graphics => graphics_setup,
2541 "Configure the video mode, performance, fonts and other graphical aspects of the game.");
2542 $SETUP_NOTEBOOK->add_tab (Audio => audio_setup,
2543 "Configure the use of audio, sound effects and background music.");
2544 $SETUP_NOTEBOOK->add_tab (Keyboard => $SETUP_KEYBOARD = keyboard_setup,
2545 "Lets you define, edit and delete key bindings."
2546 . "There is a shortcut for making bindings: <b>Control-Insert</b> opens the binding editor "
2547 . "with nothing set and the recording started. After doing the actions you "
2548 . "want to record press <b>Insert</b> and you will be asked to press a key-combo. "
2549 . "After pressing the combo the binding will be saved automatically and the "
2550 . "binding editor closes");
2551 $SETUP_NOTEBOOK->add_tab (Debug => debug_setup,
2552 "Some debuggin' options. Do not ask.");
2553
2554 make_help_window;
2555 make_menubar;
2556
2557 $SETUP_DIALOG->show;
2558 $MESSAGE_WINDOW->show;
2559 }
2560
2561 $MODE_SLIDER->set_range ([$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1, 1]);
2562 $MODE_SLIDER->emit (changed => $CFG->{sdl_mode});
2563
2564 $CAVEAT_LABEL->set_text ("None :)");
2565 $CAVEAT_LABEL->set_text ("Software Rendering (very slow)")
2566 unless DC::SDL_GL_GetAttribute DC::SDL_GL_ACCELERATED_VISUAL;
2567
2568 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
2569 }
2570
2571 sub video_shutdown {
2572 DC::OpenGL::shutdown;
2573 DC::SDL_QuitSubSystem DC::SDL_INIT_VIDEO if $SDL_REINIT;
2574
2575 undef $SDL_ACTIVE;
2576 }
2577
2578 my %animate_object;
2579 my $animate_timer;
2580
2581 my $fps = 9;
2582
2583 sub force_refresh {
2584 if ($ENV{CFPLUS_DEBUG} & 4) {
2585 $fps = $fps * 0.98 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.02;
2586 debug sprintf "%3.2f", $fps;
2587 }
2588
2589 undef $WANT_REFRESH;
2590 $_[0]->stop;
2591
2592 $DC::UI::ROOT->draw;
2593 DC::SDL_GL_SwapBuffers;
2594 $LAST_REFRESH = $NOW;
2595 }
2596
2597 my $want_refresh = EV::prepare_ns \&force_refresh;
2598
2599 my $input = EV::periodic 0, 1 / $MAX_FPS, undef, sub {
2600 $NOW = EV::now;
2601
2602 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
2603 for DC::poll_events;
2604
2605 if (%animate_object) {
2606 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
2607 $WANT_REFRESH = 1;
2608 }
2609
2610 $want_refresh->start
2611 if $WANT_REFRESH;
2612 };
2613
2614 sub animation_start {
2615 my ($widget) = @_;
2616 $animate_object{$widget} = $widget;
2617 }
2618
2619 sub animation_stop {
2620 my ($widget) = @_;
2621 delete $animate_object{$widget};
2622 }
2623
2624 %SDL_CB = (
2625 DC::SDL_QUIT => sub {
2626 crash "SDL_QUIT";
2627 EV::unloop EV::UNLOOP_ALL;
2628 },
2629 DC::SDL_VIDEORESIZE => sub {
2630 },
2631 DC::SDL_VIDEOEXPOSE => sub {
2632 DC::UI::full_refresh;
2633 },
2634 DC::SDL_ACTIVEEVENT => sub {
2635 # not useful, as APPACTIVE includes only iconified state, not unmapped
2636 # printf "active %x %x %x\n", $_[0]{gain}, $_[0]{state}, DC::SDL_GetAppState;#d#
2637 # printf "a %x\n", DC::SDL_GetAppState & DC::SDL_APPACTIVE;#d#
2638 # printf "A\n" if $_[0]{state} & DC::SDL_APPACTIVE;
2639 # printf "K\n" if $_[0]{state} & DC::SDL_APPINPUTFOCUS;
2640 # printf "M\n" if $_[0]{state} & DC::SDL_APPMOUSEFOCUS;
2641 },
2642 DC::SDL_KEYDOWN => sub {
2643 if ($_[0]{mod} & DC::KMOD_ALT && $_[0]{sym} == 13) {
2644 # alt-enter
2645 video_shutdown;
2646 $FULLSCREEN_ENABLE->toggle;
2647 video_init;
2648 } else {
2649 &DC::UI::feed_sdl_key_down_event;
2650 }
2651 update_modbox;
2652 },
2653 DC::SDL_KEYUP => sub {
2654 &DC::UI::feed_sdl_key_up_event;
2655 update_modbox;
2656 },
2657 DC::SDL_MOUSEMOTION => \&DC::UI::feed_sdl_motion_event,
2658 DC::SDL_MOUSEBUTTONDOWN => \&DC::UI::feed_sdl_button_down_event,
2659 DC::SDL_MOUSEBUTTONUP => \&DC::UI::feed_sdl_button_up_event,
2660 DC::SDL_USEREVENT => sub {
2661 if ($_[0]{code} == 1) {
2662 audio_channel_finished $_[0]{data1};
2663 } elsif ($_[0]{code} == 0) {
2664 audio_music_finished;
2665 }
2666 },
2667 );
2668
2669 #############################################################################
2670
2671 $SIG{INT} = $SIG{TERM} = sub {
2672 EV::unloop;
2673 #d# TODO calling exit here hangs the process in some futex
2674 };
2675
2676 # due to mac os x + sdl combined braindamage, we need this contortion
2677 sub main {
2678 {
2679 DC::Pod::load_docwiki DC::find_rcfile "docwiki.pst";
2680
2681 if (-e "$Deliantra::VARDIR/client.cf") {
2682 DC::read_cfg "$Deliantra::VARDIR/client.cf";
2683 } else {
2684 #TODO: compatibility cruft
2685 DC::read_cfg "$Deliantra::OLDDIR/cfplusrc";
2686 print STDERR "INFO: used old configuration file\n";
2687 }
2688
2689 DC::DB::Server::run;
2690
2691 if ($CFG->{db_schema} < 1) {
2692 warn "INFO: upgrading database schema from 0 to 1, mapcache and tilecache will be lost\n";
2693 DC::DB::nuke_db;
2694 $CFG->{db_schema} = 1;
2695 DC::write_cfg;
2696 }
2697
2698 DC::DB::open_db;
2699
2700 DC::UI::set_layout ($::CFG->{layout});
2701
2702 my %DEF_CFG = (
2703 config_autosave => 1,
2704 sdl_mode => undef,
2705 fullscreen => 1,
2706 fast => 0,
2707 force_opengl11 => undef,
2708 disable_alpha => 0,
2709 smooth_movement => 1,
2710 texture_compression => 1,
2711 map_scale => 1,
2712 fow_enable => 1,
2713 fow_intensity => 0,
2714 map_smoothing => 1,
2715 gui_fontsize => 1,
2716 log_fontsize => 0.7,
2717 gauge_fontsize => 1,
2718 gauge_size => 0.35,
2719 stat_fontsize => 0.7,
2720 mapsize => 100,
2721 audio_enable => 1,
2722 audio_hw_channels => 0,
2723 audio_hw_frequency => 0,
2724 audio_hw_chunksize => 0,
2725 audio_mix_channels => 8,
2726 effects_enable => 1,
2727 effects_volume => 1,
2728 bgm_enable => 1,
2729 bgm_volume => 0.5,
2730 output_rate => "",
2731 pickup => PICKUP_SPELLBOOK | PICKUP_SKILLSCROLL | PICKUP_VALUABLES,
2732 inv_sort => "mtime",
2733 default => "profile", # default profile
2734 show_tips => 1,
2735 logview_max_par => 1000,
2736 shift_fire_stop => 0,
2737 uitheme => "wood",
2738 );
2739
2740 while (my ($k, $v) = each %DEF_CFG) {
2741 $CFG->{$k} = $v unless exists $CFG->{$k};
2742 }
2743
2744 $CFG->{profile}{default}{host} ||= "gameserver.deliantra.net";
2745 $PROFILE = $CFG->{profile}{default};
2746
2747 # convert old bindings (only default profile matters)
2748 if (my $bindings = delete $PROFILE->{bindings}) {
2749 while (my ($mod, $syms) = each %$bindings) {
2750 while (my ($sym, $cmds) = each %$syms) {
2751 push @{ $PROFILE->{macro} }, {
2752 accelkey => [$mod*1, $sym*1],
2753 action => $cmds,
2754 };
2755 }
2756 }
2757 }
2758
2759 sdl_init;
2760
2761 {
2762 my @fonts = map DC::find_rcfile "fonts/$_", qw(
2763 DejaVuSans.ttf
2764 DejaVuSansMono.ttf
2765 DejaVuSans-Bold.ttf
2766 DejaVuSansMono-Bold.ttf
2767 DejaVuSans-Oblique.ttf
2768 DejaVuSansMono-Oblique.ttf
2769 DejaVuSans-BoldOblique.ttf
2770 DejaVuSansMono-BoldOblique.ttf
2771 );
2772
2773 DC::add_font $_ for @fonts;
2774
2775 $FONT_PROP = new_from_file DC::Font $fonts[0];
2776 $FONT_FIXED = new_from_file DC::Font $fonts[1];
2777
2778 $FONT_PROP->make_default;
2779
2780 DC::pango_init;
2781 }
2782
2783 # compare mono (ft) vs. rgba (cairo)
2784 # ft - 1.8s, cairo 3s, even in alpha-only mode
2785 # for my $rgba (0..1) {
2786 # my $t1 = Time::HiRes::time;
2787 # for (1..1000) {
2788 # my $layout = DC::Layout->new ($rgba);
2789 # $layout->set_text ("hallo" x 100);
2790 # $layout->render;
2791 # }
2792 # my $t2 = Time::HiRes::time;
2793 # warn $t2-$t1;
2794 # }
2795
2796 video_init;
2797 audio_init;
2798 }
2799
2800 show_tip_of_the_day if $CFG->{show_tips};
2801
2802 our $STARTUP_CANCEL = EV::idle sub {
2803 undef $::STARTUP_CANCEL;
2804 $startup_done->();
2805 };
2806
2807 delete $SIG{__DIE__};
2808 EV::loop;
2809
2810 DC::write_cfg if $CFG->{config_autosave};
2811
2812 #video_shutdown;
2813 #audio_shutdown;
2814
2815 DC::OpenGL::quit;
2816 DC::SDL_Quit;
2817 DC::DB::Server::stop;
2818 }
2819
2820 DC::SDL_braino; # see sub above
2821
2822 =head1 NAME
2823
2824 deliantra - A Deliantra MORPG game client
2825
2826 =head1 SYNOPSIS
2827
2828 Just run it - no commandline arguments are supported.
2829
2830 =head1 USAGE
2831
2832 deliantra utilises OpenGL for all UI elements and the game. It is supposed to
2833 be used in fullscreen mode and interactively.
2834
2835 =head1 DEBUGGING
2836
2837
2838 CFPLUS_DEBUG - environment variable
2839
2840 1 draw borders around widgets
2841 2 add low-level widget info to tooltips
2842 4 show fps
2843 8 suppress tooltips
2844
2845 =head1 AUTHOR
2846
2847 Marc Lehmann <deliantra@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
2848
2849
2850