ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/deliantra
Revision: 1.95
Committed: Sun Apr 26 19:10:57 2009 UTC (15 years, 1 month ago) by root
Branch: MAIN
CVS Tags: rel-2_04
Changes since 1.94: +6 -2 lines
Log Message:
*** empty log message ***

File Contents

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