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