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