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

File Contents

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