ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/deliantra
Revision: 1.98
Committed: Mon Dec 21 03:30:23 2009 UTC (14 years, 5 months ago) by root
Branch: MAIN
Changes since 1.97: +17 -2 lines
Log Message:
*** empty log message ***

File Contents

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