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