ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/deliantra
Revision: 1.112
Committed: Thu Apr 22 11:18:04 2010 UTC (14 years, 1 month ago) by root
Branch: MAIN
Changes since 1.111: +5 -4 lines
Log Message:
display name of audiodriver

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