ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/deliantra
Revision: 1.94
Committed: Sun Mar 29 22:28:13 2009 UTC (15 years, 1 month ago) by root
Branch: MAIN
Changes since 1.93: +5 -3 lines
Log Message:
*** empty log message ***

File Contents

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