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