ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/deliantra
Revision: 1.99
Committed: Tue Dec 22 00:35:44 2009 UTC (14 years, 6 months ago) by root
Branch: MAIN
Changes since 1.98: +15 -0 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 #!/opt/bin/perl
2    
3 root 1.7 if ($ENV{DELIANTRA_CORO_DEBUG}) {
4     eval '
5     use Coro;
6     use Coro::EV;
7     use Coro::Debug;
8     our $debug = new_unix_server Coro::Debug "/tmp/dc";
9     ';
10     }
11    
12 root 1.1 # do splash-screen thingy on win32
13     my $startup_done = sub { };
14     BEGIN {
15     if (%PAR::LibCache && $^O eq "MSWin32") {
16     while (my ($filename, $zip) = each %PAR::LibCache) {
17     $zip->extractMember ("SPLASH.bmp", "$ENV{PAR_TEMP}/SPLASH.bmp");
18     }
19    
20     require Win32::GUI::SplashScreen;
21    
22 root 1.84 # initialise the resolver now, as vista forces us back to the desktop
23     # when doing this.
24     use AnyEvent::DNS ();
25     AnyEvent::DNS::resolver;
26    
27 root 1.1 Win32::GUI::SplashScreen::Show (
28     -file => "$ENV{PAR_TEMP}/SPLASH.bmp",
29     );
30    
31     $startup_done = sub {
32     Win32::GUI::SplashScreen::Done (1);
33     };
34     }
35     }
36    
37     use strict;
38     use utf8;
39    
40     use Carp 'verbose';
41    
42     # do things only needed for single-binary version (par)
43     BEGIN {
44     if (%PAR::LibCache) {
45     @INC = grep ref, @INC; # weed out all paths except pars loader refs
46    
47     my $root = $ENV{PAR_TEMP};
48    
49     while (my ($filename, $zip) = each %PAR::LibCache) {
50     for ($zip->memberNames) {
51     next unless /^root\/(.*)/;
52     $zip->extractMember ($_, "$root/$1")
53     unless -e "$root/$1";
54     }
55     }
56    
57     if ($^O eq "MSWin32") {
58     # pango is relocatable on win32
59 root 1.60 } else {
60     # OS X
61     $ENV{PANGO_RC_FILE} = "$root/pango.rc";
62 root 1.71 $ENV{DYLD_LIBRARY_PATH} = $root;
63 root 1.60 chdir $root; # for pango modules, maybe other things
64 root 1.1 }
65    
66     unshift @INC, $root;
67     }
68     }
69    
70 root 1.94 # prepend private library directory and prepare env
71 root 1.17 BEGIN {
72     for (grep !ref, @INC) {
73 root 1.24 my $path = "$_/Deliantra/Client/private";
74 root 1.17 if (-d $path) {
75     unshift @INC, $path;
76     last;
77     }
78     }
79     }
80    
81 root 1.1 # need to do it again because that pile of garbage called PAR nukes it before main
82     unshift @INC, $ENV{PAR_TEMP}
83     if %PAR::LibCache;
84    
85 root 1.4 use EV;
86 root 1.67 BEGIN { *time = \&EV::time }
87    
88 root 1.1 use List::Util qw(max min);
89    
90 root 1.14 use Deliantra;
91     use Deliantra::Protocol::Constants;
92 root 1.1
93 root 1.66 use AnyEvent::Util ();
94 root 1.51 use AnyEvent::Socket ();
95 root 1.83 use AnyEvent::DNS ();
96 root 1.46
97 root 1.1 use Compress::LZF;
98 root 1.66 use JSON::XS;
99 root 1.1
100 root 1.44 use DC;
101 root 1.66
102     sub crash($;$) {
103 root 1.67 # nop during compiletime
104 root 1.66 }
105    
106     BEGIN {
107     $SIG{__DIE__} = sub {
108     return if $^S;
109 root 1.68 crash "CRASH/DIE: $_[0]" => 1;
110 root 1.66 DC::fatal Carp::longmess "$_[0]";
111     }
112     }
113    
114 root 1.18 use DC::OpenGL ();
115     use DC::Protocol;
116     use DC::DB;
117     use DC::UI;
118     use DC::UI::Canvas;
119     use DC::UI::Inventory;
120     use DC::UI::SpellList;
121     use DC::UI::Dockable;
122 elmex 1.23 use DC::UI::Dockbar;
123 root 1.18 use DC::UI::ChatView;
124 elmex 1.23 use DC::MessageDistributor;
125 root 1.18 use DC::Pod;
126     use DC::MapWidget;
127     use DC::Macro;
128 root 1.1
129     $SIG{QUIT} = sub { Carp::cluck "QUIT" };
130     $SIG{PIPE} = 'IGNORE';
131    
132 root 1.4 $EV::DIED = sub {
133 root 1.82 crash "CRASH/EV::DIED: $@" => 0;
134 root 1.18 DC::fatal Carp::longmess $@;
135 root 1.1 };
136    
137     my $MAX_FPS = 60;
138    
139 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.99 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "FoW Pattern");
1070     $table->add_at (1, $row++, new DC::UI::ImageButton
1071     tex => $DC::MapWidget::TEX_HIDDEN[$CFG->{fow_texture}],
1072     bg => [0.3, 0.3, 0.2],
1073     force_w => 64,
1074     force_h => 64,
1075     tooltip => "<b>Fog of War Pattern.</b> The pattern that is overlaid over areas hidden from view. Click to cycle through various alternatives. Changes are instant.",
1076     on_activate => sub {
1077     my ($self) = @_;
1078     $CFG->{fow_texture} = ($CFG->{fow_texture} + 1) % @DC::MapWidget::TEX_HIDDEN;
1079     $self->set_texture ($DC::MapWidget::TEX_HIDDEN[$CFG->{fow_texture}]);
1080     }
1081     );
1082    
1083 root 1.77 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "FoW Intensity");
1084     $table->add_at (1, $row++, new DC::UI::Slider
1085     range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],
1086     tooltip => "<b>Fog of War Lightness.</b> The higher the intensity, the lighter the Fog-of-War color. Changes are instant.",
1087     on_changed => sub { my ($self, $value) = @_; $CFG->{fow_intensity} = $value; 0 }
1088     );
1089 root 1.1
1090 root 1.77 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Message Fontsize");
1091     $table->add_at (1, $row++, new DC::UI::Slider
1092     range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],
1093     tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant, "
1094     . "but you still need to press apply to correctly re-layout the widget.",
1095     on_changed => sub { $MESSAGE_DIST->set_fontsize ($CFG->{log_fontsize} = $_[1]); 0 },
1096     );
1097 root 1.1
1098 root 1.77 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Gauge fontsize");
1099     $table->add_at (1, $row++, new DC::UI::Slider
1100     range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],
1101     tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.",
1102     on_changed => sub {
1103     $CFG->{gauge_fontsize} = $_[1];
1104     &set_gauge_window_fontsize;
1105     0
1106     }
1107     );
1108 root 1.1
1109 root 1.77 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Gauge size");
1110     $table->add_at (1, $row++, new DC::UI::Slider
1111     range => [$CFG->{gauge_size}, 0.2, 0.8],
1112     tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",
1113     on_changed => sub {
1114     $CFG->{gauge_size} = $_[1];
1115     $GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
1116     0
1117     }
1118     );
1119     }
1120 root 1.1
1121     $vbox
1122     }
1123    
1124     our $AUDIO_HW_CHUNKSIZE;
1125     our $AUDIO_INFO;
1126    
1127     sub audio_tab_update {
1128 root 1.18 my ($freq, $format, $chans) = DC::Mix_QuerySpec;
1129 root 1.1
1130     $AUDIO_HW_CHUNKSIZE->set_options ([
1131     [0, "default", "Use System Default"],
1132     map {
1133     my $ms = sprintf "%dms", 1000 * $_ / ($CFG->{audio_hw_frequency} || 22050);
1134     [$_, $ms, "$ms ($_ samples)"],
1135     } 256, 512, 1024, 2048, 4096, 8192, 16384, 32768
1136     ]);
1137    
1138     my $text = !$freq
1139     ? "audio is off"
1140     : "audio is enabled\n"
1141     . "frequency (Hz): $freq\n"
1142     . "channels: $chans";
1143    
1144     $AUDIO_INFO->set_text ($text);
1145     }
1146    
1147     sub audio_setup {
1148 root 1.18 my $vbox = new DC::UI::VBox;
1149 root 1.1
1150 root 1.18 $vbox->add (my $table = new DC::UI::Table expand => 1, col_expand => [0, 0, 1]);
1151 root 1.1
1152     my $row = 0;
1153    
1154 root 1.22 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Audio Enable");
1155 root 1.18 $table->add_at (1, $row++, new DC::UI::CheckBox
1156 root 1.1 state => $CFG->{audio_enable},
1157     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.",
1158     on_changed => sub { $CFG->{audio_enable} = $_[1]; 1 }
1159     );
1160    
1161 root 1.22 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Sound Effects");
1162 root 1.18 $table->add_at (1, $row, new DC::UI::CheckBox
1163 root 1.1 expand => 1, state => $CFG->{effects_enable},
1164     tooltip => "If enabled, sound effects are enabled. If disabled, no sound effects will be played.",
1165     on_changed => sub {
1166     $CFG->{effects_enable} = $_[1];
1167     $CONN->update_fx_want if $CONN;
1168     1
1169     }
1170     );
1171 root 1.18 $table->add_at (2, $row++, new DC::UI::Slider
1172 root 1.1 expand => 1, range => [$CFG->{effects_volume}, 0, 1, 0, 1/128],
1173     tooltip => "The relative volume of sound effects. Best audio quality is achieved if this "
1174     . "is set highest (rightmost) and you use your operating system volume setting. Changes are instant.",
1175     on_changed => sub { $CFG->{effects_volume} = $_[1]; 1 }
1176     );
1177    
1178 root 1.22 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Background Music");
1179 root 1.18 $table->add_at (1, $row, new DC::UI::CheckBox
1180 root 1.1 expand => 1, state => $CFG->{bgm_enable},
1181     tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",
1182     on_changed => sub {
1183     $CFG->{bgm_enable} = $_[1];
1184     $CONN->update_fx_want if $CONN;
1185     audio_music_push;
1186     1
1187     }
1188     );
1189 root 1.18 $table->add_at (2, $row++, new DC::UI::Slider
1190 root 1.1 expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],
1191     tooltip => "The volume of the background music. Changes are instant.",
1192     on_changed => sub { $CFG->{bgm_volume} = $_[1]; audio_music_update_volume; 0 }
1193     );
1194    
1195 root 1.22 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Frequency");
1196 root 1.18 $table->add_at (1, $row++, new DC::UI::Selector
1197 root 1.1 c_colspan => 2, expand => 1,
1198     value => $CFG->{audio_hw_frequency},
1199     options => [
1200     [ 0, "default" , "Use System Default"],
1201     [11025, "11 kHz" , "11kHz (low quality)"],
1202     [22050, "22 kHz" , "22kHz (reduced quality)"],
1203     [44100, "44.1 kHz", "44.1kHz (cd quality)"],
1204     [48000, "48 kHz" , "48kHz (studio quality)"],
1205     ],
1206     tooltip => "The sampling frequency to use. Higher sounds better, but also more cpu-intensive and might cause stuttering.",
1207     on_changed => sub {
1208     $CFG->{audio_hw_frequency} = $_[1];
1209     audio_tab_update;
1210     1
1211     }
1212     );
1213    
1214 root 1.22 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Channels");
1215 root 1.18 $table->add_at (1, $row++, new DC::UI::Selector
1216 root 1.1 c_colspan => 2, expand => 1,
1217     value => $CFG->{audio_hw_channels},
1218     options => [
1219     [0, "default" , "Use System Default"],
1220     [1, "Mono" , "Mono (single channel, low quality)"],
1221 root 1.6 [2, "Stereo" , "Stereo (dual channel, standard quality)"],
1222 root 1.1 [4, "4 Ch Surround", "4 Channel Surround Sound (3d sound, high quality)"],
1223     [6, "6 Ch Surround", "6 Channel Surround Sound (3d sound + center + lfe)"],
1224     ],
1225     tooltip => "The number of independent sound channels to use. Higher sounds better, but also more cpu-intensive and might cause stuttering.",
1226     on_changed => sub {
1227     $CFG->{audio_hw_channels} = $_[1];
1228     audio_tab_update;
1229     1
1230     }
1231     );
1232    
1233 root 1.22 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Latency");
1234 root 1.18 $table->add_at (1, $row++, $AUDIO_HW_CHUNKSIZE = new DC::UI::Selector
1235 root 1.1 c_colspan => 2, expand => 1,
1236     value => $CFG->{audio_hw_chunksize},
1237     tooltip => "The guarenteed latency. Lower is better, but also more cpu-intensive and might cause stuttering. If music playback "
1238     . "is stuttering, increase this value. Values of 50-100ms are optimal.",
1239     on_changed => sub {
1240     $CFG->{audio_hw_chunksize} = $_[1];
1241     audio_tab_update;
1242     1
1243     }
1244     );
1245    
1246     # should really be a slider
1247 root 1.22 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Mixer Voices");
1248 root 1.18 $table->add_at (1, $row++, new DC::UI::ValSlider
1249 root 1.1 c_colspan => 2, expand => 1,
1250     tooltip => "The number of simultaneous sound effects possible. Higher is better, but also more cpu-intensive and might cause stuttering.",
1251     range => [$::CFG->{audio_mix_channels}, 4, 32, 0, 1],
1252     template => ">= 99",
1253     on_changed => sub {
1254     my ($slider, $value) = @_;
1255    
1256     $CFG->{audio_mix_channels} = $value
1257     if $value;
1258     1;
1259     }
1260     );
1261    
1262 root 1.18 $table->add_at (1, $row++, new DC::UI::Button
1263 root 1.22 c_colspan => 2, expand => 1, text => "Apply",
1264 root 1.1 tooltip => "Apply the audio settings",
1265     on_activate => sub {
1266     audio_shutdown ();
1267     audio_init ();
1268     0
1269     }
1270     );
1271    
1272 root 1.18 $vbox->add (new DC::UI::FancyFrame
1273 root 1.1 expand => 1,
1274     label => "Audio Info",
1275 root 1.18 child => ($AUDIO_INFO = new DC::UI::Label ellipsise => 0),
1276 root 1.1 );
1277    
1278     audio_tab_update;
1279    
1280     $vbox
1281     }
1282    
1283     sub set_gauge_window_fontsize {
1284     for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {
1285     $_->set_fontsize ($::CFG->{gauge_fontsize});
1286     }
1287     }
1288    
1289     sub make_gauge_window {
1290     my $gh = int $HEIGHT * $CFG->{gauge_size};
1291    
1292 root 1.85 $GAUGES->{win} = my $win = new DC::UI::Frame (
1293 root 1.1 force_x => 0,
1294     force_y => "max",
1295     force_w => $WIDTH,
1296     force_h => $gh,
1297     );
1298    
1299 root 1.18 $win->add (my $hbox = new DC::UI::HBox
1300 root 1.1 children => [
1301 root 1.18 (new DC::UI::HBox expand => 1),
1302     (new DC::UI::VBox children => [
1303     (new DC::UI::Empty expand => 1),
1304     (new DC::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new DC::UI::Table)),
1305 root 1.1 ]),
1306 root 1.18 (my $vbox = new DC::UI::VBox),
1307 root 1.1 ],
1308     );
1309    
1310 root 1.18 $vbox->add (new DC::UI::HBox
1311 root 1.1 expand => 1,
1312     children => [
1313 root 1.18 (new DC::UI::Empty expand => 1),
1314     (my $hb = new DC::UI::HBox),
1315 root 1.1 ],
1316     );
1317    
1318 root 1.85 $hb->add ($GAUGES->{hp} = new DC::UI::Gauge type => 'hp', tooltip => "#stat_health");
1319     $hb->add ($GAUGES->{mana} = new DC::UI::Gauge type => 'mana', tooltip => "#stat_mana");
1320     $hb->add ($GAUGES->{grace} = new DC::UI::Gauge type => 'grace', tooltip => "#stat_grace");
1321     $hb->add ($GAUGES->{food} = new DC::UI::Gauge type => 'food', tooltip => "#stat_food");
1322 root 1.1
1323     &set_gauge_window_fontsize;
1324    
1325     $win
1326     }
1327    
1328     sub debug_setup {
1329 root 1.18 my $table = new DC::UI::Table;
1330 root 1.1
1331 root 1.18 $table->add_at (0, 0, new DC::UI::Label text => "Widget Borders");
1332     $table->add_at (1, 0, new DC::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 1; 0 });
1333     $table->add_at (0, 1, new DC::UI::Label text => "Tooltip Widget Info");
1334     $table->add_at (1, 1, new DC::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 2; 0 });
1335     $table->add_at (0, 2, new DC::UI::Label text => "Show FPS");
1336     $table->add_at (1, 2, new DC::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 4; 0 });
1337     $table->add_at (0, 3, new DC::UI::Label text => "Suppress Tooltips");
1338     $table->add_at (1, 3, new DC::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 8; 0 });
1339     $table->add_at (0, 4, new DC::UI::Button text => "die on click(tm)", on_activate => sub { &DC::debug() } );
1340    
1341 root 1.21 $table->add_at (0, 5, new DC::UI::TextEdit text => "line1\0152\0153\nµikachu\nづx゙つ゛");#d#
1342 root 1.18
1343     $table->add_at (7,7, my $t = new DC::UI::Table expand => 0);
1344 root 1.20 $t->add_at (0,0, new DC::UI::Label text => "a a", c_rowspan => 1, c_colspan => 2);
1345     $t->add_at (2,0, new DC::UI::Label text => "b\nb", c_rowspan => 2, c_colspan => 1, ellipsise => 0 );
1346     $t->add_at (1,2, new DC::UI::Label text => "c c", c_rowspan => 1, c_colspan => 2);
1347     $t->add_at (0,1, new DC::UI::Label text => "d\nd", c_rowspan => 2, c_colspan => 1, ellipsise => 0 );
1348 root 1.18 $t->add_at (1,1, new DC::UI::Label text => "e");
1349 root 1.1
1350 root 1.18 $table->add_at (7, 6, my $c = new DC::UI::Canvas);
1351 root 1.1
1352     $c->add_items ({
1353     type => "line_loop",
1354     color => [0, 1, 0],
1355     width => 9,
1356     coord_mode => "abs",
1357     coord => [[10, 5], [5, 50], [20, 5], [5, 60]],
1358     });
1359    
1360     $c->add_items ({
1361     type => "lines",
1362     color => [1, 1, 0],
1363     width => 2,
1364     coord_mode => "rel",
1365     coord => [[0,0], [1,1], [1,0], [0,1]],
1366     });
1367    
1368     $c->add_items ({
1369     type => "polygon",
1370     color => [0, 0.43, 0],
1371     width => 2,
1372     coord_mode => "rel",
1373     coord => [[0,0.2], [1,.4], [1,.6], [0,.8]],
1374     });
1375    
1376     $table
1377     }
1378    
1379     sub stats_window {
1380 root 1.18 my $r = new DC::UI::ScrolledWindow (
1381 root 1.1 expand => 1,
1382     scroll_y => 1
1383     );
1384 root 1.18 $r->add (my $vb = new DC::UI::VBox);
1385 root 1.1
1386 root 1.18 $vb->add (new DC::UI::FancyFrame
1387 root 1.1 label => "Player",
1388 root 1.18 child => (my $pi = new DC::UI::VBox),
1389 root 1.1 );
1390    
1391 root 1.22 $pi->add ($STATWIDS->{title} = new DC::UI::Label text => "Title:", expand => 1, align => 0,
1392 root 1.1 can_hover => 1, can_events => 1,
1393     tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");
1394 root 1.22 $pi->add ($STATWIDS->{map} = new DC::UI::Label align => 0, text => "Map:", expand => 1,
1395 root 1.1 can_hover => 1, can_events => 1,
1396     tooltip => "The map you are currently on (if supported by the server).");
1397    
1398 root 1.18 $pi->add (my $hb0 = new DC::UI::HBox);
1399 root 1.22 $hb0->add ($STATWIDS->{weight} = new DC::UI::Label text => "Weight:", expand => 1, align => 0,
1400 root 1.1 can_hover => 1, can_events => 1,
1401     tooltip => "The weight of the player including all inventory items.");
1402 root 1.22 $hb0->add ($STATWIDS->{m_weight} = new DC::UI::Label align => 0, text => "Max weight:", expand => 1,
1403 root 1.1 can_hover => 1, can_events => 1,
1404     tooltip => "The weight limit: you cannot carry more than this.");
1405    
1406 root 1.18 $vb->add (new DC::UI::FancyFrame
1407 root 1.1 label => "Primary/Secondary Statistics",
1408 root 1.18 child => (my $hb = new DC::UI::HBox expand => 1),
1409 root 1.1 );
1410 root 1.18 $hb->add (my $tbl = new DC::UI::Table expand => 1);
1411 root 1.1
1412     my $color2 = [1, 1, 0];
1413    
1414     for (
1415     [0, 0, st_str => "Str", 30],
1416     [0, 1, st_dex => "Dex", 30],
1417     [0, 2, st_con => "Con", 30],
1418     [0, 3, st_int => "Int", 30],
1419     [0, 4, st_wis => "Wis", 30],
1420     [0, 5, st_pow => "Pow", 30],
1421     [0, 6, st_cha => "Cha", 30],
1422    
1423     [2, 0, st_wc => "Wc", -120],
1424     [2, 1, st_ac => "Ac", -120],
1425     [2, 2, st_dam => "Dam", 120],
1426     [2, 3, st_arm => "Arm", 120],
1427     [2, 4, st_spd => "Spd", 10.54],
1428     [2, 5, st_wspd => "WSp", 10.54],
1429     ) {
1430     my ($col, $row, $id, $label, $template) = @$_;
1431    
1432 root 1.18 $tbl->add_at ($col , $row, $STATWIDS->{$id} = new DC::UI::Label
1433 root 1.22 font => $FONT_FIXED, can_hover => 1, can_events => 1,
1434     align => 1, template => $template, tooltip => "#stat_$label");
1435 root 1.18 $tbl->add_at ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new DC::UI::Label
1436 root 1.22 font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $color2,
1437     align => 0, text => $label, tooltip => "#stat_$label");
1438 root 1.1 }
1439    
1440 root 1.18 $vb->add (new DC::UI::FancyFrame
1441 root 1.1 label => "Resistancies",
1442 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]),
1443 root 1.1 );
1444    
1445     my $row = 0;
1446     my $col = 0;
1447    
1448     my %resist_names = (
1449     slow => ["Slow",
1450     "<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.)"],
1451     holyw => ["Holy Word",
1452     "<b>Holy Word</b> (resistance you against getting the fear when someone whose god doesn't like you spells the holy word on you.)"],
1453     conf => ["Confusion",
1454     "<b>Confusion</b> (If you are hit by confusion you will move into random directions, and likely into monsters.)"],
1455     fire => ["Fire",
1456     "<b>Fire</b> (just your resistance to fire spells like burning hands, dragonbreath, meteor swarm fire, ...)"],
1457     depl => ["Depletion",
1458     "<b>Depletion</b> (some monsters and other effects can cause stats depletion)"],
1459     magic => ["Magic",
1460     "<b>Magic</b> (resistance to magic spells like magic missile or similar)"],
1461     drain => ["Draining",
1462     "<b>Draining</b> (some monsters (e.g. vampires) and other effects can steal experience)"],
1463     acid => ["Acid",
1464     "<b>Acid</b> (resistance to acid, acid hurts pretty much and also corrodes your weapons)"],
1465     pois => ["Poison",
1466     "<b>Poison</b> (resistance to getting poisoned)"],
1467     para => ["Paralysation",
1468     "<b>Paralysation</b> (this resistance affects the chance you get paralysed)"],
1469     deat => ["Death",
1470     "<b>Death</b> (resistance against death spells)"],
1471     phys => ["Physical",
1472     "<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.)"],
1473     blind => ["Blind",
1474     "<b>Blind</b> (blind resistance affects the chance of a successful blinding attack)"],
1475     fear => ["Fear",
1476     "<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)"],
1477     tund => ["Turn undead",
1478     "<b>Turn undead</b> (affects your resistancy to various forms of 'turn undead' spells. Only relevant when you are, in fact, undead..."],
1479     elec => ["Electricity",
1480     "<b>Electricity</b> (resistance against electricity, spells like large lightning, small lightning, ...)"],
1481     cold => ["Cold",
1482     "<b>Cold</b> (this is your resistance against cold spells like icestorm, snowstorm, ...)"],
1483     ghit => ["Ghost hit",
1484     "<b>Ghost hit</b> (special attack used by ghosts and ghost-like beings)"],
1485     );
1486    
1487     for (qw/slow holyw conf fire depl magic
1488     drain acid pois para deat phys
1489     blind fear tund elec cold ghit/)
1490     {
1491 root 1.22 $tbl2->add_at ($col + 2, $row,
1492 root 1.1 $STATWIDS->{"res_$_"} =
1493 root 1.18 new DC::UI::Label
1494 root 1.1 font => $FONT_FIXED,
1495     template => "-100%",
1496 root 1.22 align => 1,
1497 root 1.1 can_events => 1,
1498     can_hover => 1,
1499     tooltip => $resist_names{$_}->[1],
1500     );
1501 root 1.18 $tbl2->add_at ($col + 1, $row, new DC::UI::Image
1502 root 1.1 font => $FONT_FIXED,
1503     can_hover => 1,
1504     can_events => 1,
1505     path => "ui/resist/resist_$_.png",
1506     tooltip => $resist_names{$_}->[1],
1507     );
1508 root 1.22 $tbl2->add_at ($col + 0, $row, new DC::UI::Label
1509 root 1.1 text => $resist_names{$_}->[0],
1510     font => $FONT_FIXED,
1511 root 1.22 align => 1,
1512 root 1.1 can_hover => 1,
1513     can_events => 1,
1514     tooltip => $resist_names{$_}->[1],
1515     );
1516    
1517     $row++;
1518     if ($row % 6 == 0) {
1519 root 1.22 $col += 4;
1520 root 1.1 $row = 0;
1521     }
1522     }
1523    
1524     #update_stats_window ({});
1525    
1526     $r
1527     }
1528    
1529     sub skill_window {
1530 root 1.18 my $sw = new DC::UI::ScrolledWindow (expand => 1);
1531 root 1.1
1532 root 1.18 $sw->add ($STATWIDS->{skill_tbl} = new DC::UI::Table expand => 1, col_expand => [0, 0, 1, .1, 0, 0, 1, .1]);
1533 root 1.1
1534     $sw
1535     }
1536    
1537     sub formsep($) {
1538     scalar reverse join ",", unpack "(A3)*", reverse $_[0] * 1
1539     }
1540    
1541     my $METASERVER_ATIME;
1542    
1543     sub update_metaserver {
1544     my ($metaserver_dialog) = @_;
1545    
1546     $METASERVER = $metaserver_dialog
1547     if defined $metaserver_dialog;
1548    
1549     return if $METASERVER_ATIME > time;
1550     $METASERVER_ATIME = time + 60;
1551    
1552     my $table = $METASERVER->{table};
1553     $table->clear;
1554 root 1.18 $table->add_at (0, 0, my $label = new DC::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
1555 root 1.1
1556     my $ok = 0;
1557    
1558 root 1.18 DC::background {
1559     my $ua = DC::lwp_useragent;
1560 root 1.1
1561 root 1.18 DC::background_msg DC::decode_json +(DC::lwp_check $ua->get ($META_SERVER))->decoded_content;
1562 root 1.1 } sub {
1563     my ($msg) = @_;
1564     if ($msg) {
1565     $table->clear;
1566    
1567     my @tip = (
1568     "The current number of users logged in on the server.",
1569     "The hostname of the server.",
1570     "The time this server has been running without being restarted.",
1571     "Short information about this server provided by its admins.",
1572     );
1573     my @col = qw(#Users Host Uptime Version Description);
1574 root 1.18 $table->add_at ($_, 0, new DC::UI::Label
1575 root 1.22 can_hover => 1, can_events => 1, fg => [1, 1, 0],
1576 root 1.1 text => $col[$_], tooltip => $tip[$_])
1577     for 0 .. $#col;
1578    
1579 root 1.22 my @align = qw(1 0.5 1 1 0);
1580 root 1.1
1581     my $y = 0;
1582     for my $m (@{ $msg->{servers} }) {
1583     my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime, $highlight) =
1584     @$m{qw(ip age hostname users version description ibytes obytes uptime highlight)};
1585    
1586     for ($desc) {
1587     s/<br>/\n/gi;
1588     s/<li>/\n· /gi;
1589     s/<.*?>//sgi;
1590     s/&amp;/&/g;
1591     s/&lt;/</g;
1592     s/&gt;/>/g;
1593     }
1594    
1595     $uptime = sprintf "%dd %02d:%02d:%02d",
1596     (int $uptime / 86400),
1597     (int $uptime / 3600) % 24,
1598     (int $uptime / 60) % 60,
1599     $uptime % 60;
1600    
1601     $m = [$users, $host, $uptime, $version, $desc];
1602    
1603     $y++;
1604    
1605 root 1.18 $table->add_at (scalar @$m, $y, new DC::UI::VBox children => [
1606     (new DC::UI::Button
1607 root 1.1 text => "Use",
1608     tooltip => "Put this server into the <b>Host:Port</b> field",
1609     on_activate => sub {
1610     $HOST_ENTRY->set_text ($CFG->{profile}{default}{host} = $host);
1611     $METASERVER->hide;
1612     0
1613     },
1614     ),
1615 root 1.18 (new DC::UI::Empty expand => 1),
1616 root 1.1 ]);
1617    
1618 root 1.18 $table->add_at ($_, $y, new DC::UI::Label
1619 root 1.1 max_w => $::WIDTH * 0.4,
1620     ellipsise => 0,
1621     align => $align[$_],
1622     text => $m->[$_],
1623     tooltip => $tip[$_],
1624     fg => ($highlight ? [1, 1, 1] : [.7, .7, .7]),
1625     can_hover => 1,
1626     can_events => 1,
1627     fontsize => 0.8)
1628     for 0 .. $#$m;
1629     }
1630     } else {
1631     $ok or $label->set_text ("error while contacting metaserver");
1632     }
1633     };
1634    
1635     }
1636    
1637     sub metaserver_dialog {
1638 root 1.18 my $vbox = new DC::UI::VBox;
1639     my $table = new DC::UI::Table;
1640     $vbox->add (new DC::UI::ScrolledWindow expand => 1, child => $table);
1641 root 1.1
1642 root 1.18 my $dialog = new DC::UI::Toplevel
1643 root 1.1 title => "Server List",
1644     name => 'metaserver_dialog',
1645     x => 'center',
1646     y => 'center',
1647     z => 3,
1648     force_w => $::WIDTH * 0.9,
1649     force_h => $::HEIGHT * 0.7,
1650     child => $vbox,
1651     has_close_button => 1,
1652     table => $table,
1653     on_visibility_change => sub {
1654     update_metaserver ($_[0]) if $_[1];
1655     0
1656     },
1657     ;
1658    
1659     $dialog
1660     }
1661    
1662     sub login_setup {
1663 root 1.18 my $vbox = new DC::UI::VBox;
1664 root 1.1
1665 root 1.18 $vbox->add (new DC::UI::FancyFrame
1666 root 1.1 label => "Login Settings",
1667 root 1.18 child => (my $table = new DC::UI::Table expand => 1, col_expand => [0, 1]),
1668 root 1.1 );
1669    
1670 root 1.22 $table->add_at (0, 4, new DC::UI::Label align => 1, text => "Username");
1671 root 1.18 $table->add_at (1, 4, new DC::UI::Entry
1672 root 1.1 text => $CFG->{profile}{default}{user},
1673 root 1.86 tooltip => "The name of your character on the server. The name is case-sensitive!",
1674 root 1.1 on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{user} = $value; 1 }
1675     );
1676    
1677 root 1.22 $table->add_at (0, 5, new DC::UI::Label align => 1, text => "Password");
1678 root 1.18 $table->add_at (1, 5, new DC::UI::Entry
1679 root 1.1 text => $CFG->{profile}{default}{password},
1680     hidden => 1,
1681     tooltip => "The password for your character.",
1682     on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{password} = $value; 1 }
1683     );
1684    
1685 root 1.18 $table->add_at (1, 11, $LOGIN_BUTTON = new DC::UI::Button
1686 root 1.1 expand => 1,
1687     text => "Login / Register",
1688     tooltip => "This button will either login to the account configured above or register a new account.",
1689     on_activate => sub {
1690     $CONN ? stop_game
1691     : start_game;
1692     1
1693     },
1694     );
1695    
1696 root 1.18 $vbox->add (new DC::UI::FancyFrame
1697 root 1.61 label => "How to Play",
1698 root 1.65 min_h => 240,
1699 root 1.22 child => (new DC::UI::Label valign => 0, ellipsise => 0,
1700 root 1.1 markup =>
1701 root 1.63 "First select a suitable video resolution in the <b>Graphics</b> tab, above.\n\n"
1702 root 1.62 . "Then register a new account (or use an existing one if you have one). "
1703     . "To register an account, choose a username that hasn't been taken yet (just guess) and "
1704 root 1.1 . "try to log-in. Follow the instructions in the Log tab in the message window.",
1705     ),
1706     );
1707    
1708     $vbox
1709     }
1710    
1711     sub server_setup {
1712 root 1.18 my $vbox = new DC::UI::VBox;
1713 root 1.1
1714 root 1.18 $vbox->add (new DC::UI::FancyFrame
1715 root 1.1 label => "Connection Settings",
1716 root 1.18 child => (my $table = new DC::UI::Table expand => 1, col_expand => [0, 1]),
1717 root 1.1 );
1718    
1719     my $row = 0;
1720    
1721 root 1.22 $table->add_at (0, ++$row, new DC::UI::Label align => 1, text => "Host:Port");
1722 root 1.1 {
1723 root 1.18 $table->add_at (1, $row, my $vbox = new DC::UI::VBox);
1724 root 1.1
1725     $vbox->add (
1726 root 1.18 $HOST_ENTRY = new DC::UI::Entry
1727 root 1.1 expand => 1,
1728     text => $CFG->{profile}{default}{host},
1729 root 1.28 tooltip => "The hostname or ip address of the Deliantra server to connect to (e.g. <b>gameserver.deliantra.net</b>)",
1730 root 1.1 on_changed => sub {
1731     my ($self, $value) = @_;
1732     $CFG->{profile}{default}{host} = $value;
1733     1
1734     }
1735     );
1736    
1737 root 1.5 if (0) { #d# disabled
1738 root 1.18 $vbox->add (new DC::UI::Button
1739 root 1.1 expand => 1,
1740     text => "Server List",
1741     other => $METASERVER,
1742 root 1.28 tooltip => "Show a list of available Deliantra servers",
1743 root 1.1 on_activate => sub { $METASERVER->toggle_visibility; 0 },
1744     on_visibility_change => sub { $METASERVER->hide unless $_[1]; 1 },
1745     );
1746 root 1.5 }#d#
1747 root 1.1 }
1748    
1749 root 1.22 $table->add_at (0, ++$row, new DC::UI::Label align => 1, text => "Map Size");
1750 root 1.18 $table->add_at (1, $row, new DC::UI::Slider
1751 root 1.1 force_w => 100,
1752     range => [$CFG->{mapsize}, 10, 100, 0, 1],
1753     tooltip => "This is the size of the portion of the map update the server sends you. "
1754     . "If you set this to a high value you will be able to see further, "
1755     . "but you also increase bandwidth requirements and latency. "
1756     . "This option is only used once at log-in.",
1757     on_changed => sub { my ($self, $value) = @_; $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 1 },
1758     );
1759    
1760 root 1.22 $table->add_at (0, ++$row, new DC::UI::Label align => 1, text => "Output-Rate");
1761 root 1.18 $table->add_at (1, $row, new DC::UI::Entry
1762 root 1.1 text => $CFG->{output_rate},
1763     tooltip => "The maximum bandwidth in bytes per second that the server should not exceed "
1764     . "when sending data. When 0 or unset, the server "
1765     . "default will be used, which is usually around 100kb/s. Most servers will "
1766     . "dynamically find an optimal rate, so adjust this only when necessary.",
1767     on_changed => sub { $CFG->{output_rate} = $_[1]; 1 },
1768     );
1769    
1770 root 1.18 $vbox->add (new DC::UI::FancyFrame
1771 root 1.1 label => "Server Info",
1772 root 1.18 child => ($SERVER_INFO = new DC::UI::Label ellipsise => 0),
1773 root 1.1 );
1774    
1775     $vbox
1776     }
1777    
1778     sub client_setup {
1779 root 1.18 my $table = new DC::UI::Table expand => 1, col_expand => [0, 1];
1780 root 1.1
1781     my $row = 0;
1782    
1783 root 1.22 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Tip of the day");
1784 root 1.18 $table->add_at (1, $row++, new DC::UI::CheckBox
1785 root 1.85 c_colspan => 2,
1786 root 1.1 state => $CFG->{show_tips},
1787     tooltip => "Show the <b>Tip of the day</b> window at startup?",
1788     on_changed => sub {
1789     my ($self, $value) = @_;
1790     $CFG->{show_tips} = $value;
1791     0
1792     }
1793     );
1794    
1795 root 1.37 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Message Window Size");
1796 root 1.18 $table->add_at (1, $row++, my $saycmd = new DC::UI::Entry
1797 root 1.85 c_colspan => 2,
1798 root 1.1 text => $CFG->{logview_max_par},
1799 root 1.37 tooltip => "This is maximum number of messages remembered in the <b>Message</b> window. If the server "
1800 root 1.1 . "sends more messages than this number, older messages get removed to save memory and "
1801     . "computing time. A value of <b>0</b> disables this feature, but that is not recommended.",
1802     on_changed => sub {
1803     my ($self, $value) = @_;
1804 root 1.28 $MESSAGE_DIST->set_max_par ($CFG->{logview_max_par} = $value*1);
1805 root 1.1 0
1806     },
1807     );
1808    
1809 root 1.85 $table->add_at (0, $row, new DC::UI::Label align => 1, text => "Config Autosave");
1810     $table->add_at (1, $row, new DC::UI::CheckBox
1811     state => $CFG->{config_autosave},
1812     tooltip => "Normally, configuration settings and the user interface layout "
1813     . "are saved on client exit. You can disable this behaviour by "
1814     . "unchecking this checkbox.",
1815     on_changed => sub {
1816     my ($self, $value) = @_;
1817     $CFG->{config_autosave} = $value;
1818     0
1819     }
1820     );
1821     $table->add_at (2, $row++, new DC::UI::Button
1822     text => "Save Now",
1823     tooltip => "Use this to manually save configuration and UI layout when "
1824     . "autosave is disabled.",
1825     on_activate => sub {
1826     DC::write_cfg;
1827     0
1828     }
1829     );
1830    
1831 root 1.1 $table
1832     }
1833    
1834     sub autopickup_setup {
1835 root 1.18 my $r = new DC::UI::ScrolledWindow (
1836 root 1.1 expand => 1,
1837     scroll_y => 1
1838     );
1839 root 1.18 $r->add (my $table = new DC::UI::Table
1840 root 1.1 row_expand => [0],
1841     col_expand => [0, 1, 0, 1],
1842     );
1843    
1844     for (
1845     ["General", 0, 0,
1846 root 1.88 # ["Inhibit autopickup" => PICKUP_INHIBIT],
1847 root 1.1 ["Stop before pickup" => PICKUP_STOP],
1848     ["Debug autopickup" => PICKUP_DEBUG],
1849     ],
1850     ["Weapons", 0, 6,
1851     ["All weapons" => PICKUP_ALLWEAPON],
1852     ["Missile weapons" => PICKUP_MISSILEWEAPON],
1853     ["Bows" => PICKUP_BOW],
1854     ["Arrows" => PICKUP_ARROW],
1855     ],
1856     ["Armour", 0, 12,
1857     ["Helmets" => PICKUP_HELMET],
1858     ["Shields" => PICKUP_SHIELD],
1859     ["Body Armour" => PICKUP_ARMOUR],
1860     ["Boots" => PICKUP_BOOTS],
1861     ["Gloves" => PICKUP_GLOVES],
1862     ["Cloaks" => PICKUP_CLOAK],
1863     ],
1864    
1865     ["Readables", 2, 0,
1866     ["Spellbooks" => PICKUP_SPELLBOOK],
1867     ["Skillscrolls" => PICKUP_SKILLSCROLL],
1868     ["Normal Books/Scrolls" => PICKUP_READABLES],
1869     ],
1870     ["Misc", 2, 5,
1871     ["Food" => PICKUP_FOOD],
1872     ["Drinks" => PICKUP_DRINK],
1873     ["Valuables (Money, Gems)" => PICKUP_VALUABLES],
1874     ["Keys" => PICKUP_KEY],
1875     ["Magical Items" => PICKUP_MAGICAL],
1876     ["Potions" => PICKUP_POTION],
1877     ["Magic Devices" => PICKUP_MAGIC_DEVICE],
1878     ["Ignore cursed" => PICKUP_NOT_CURSED],
1879     ["Jewelery" => PICKUP_JEWELS],
1880     ["Flesh" => PICKUP_FLESH],
1881     ],
1882 root 1.58 ["Value/Weight ratio", 2, 17]
1883 root 1.1 )
1884     {
1885     my ($title, $x, $y, @bits) = @$_;
1886 root 1.18 $table->add_at ($x, $y, new DC::UI::Label text => $title, align => 1, fg => [1, 1, 0]);
1887 root 1.1
1888     for (@bits) {
1889     ++$y;
1890    
1891     my $mask = $_->[1];
1892 root 1.18 $table->add_at ($x , $y, new DC::UI::Label text => $_->[0], align => 1, expand => 1);
1893     $table->add_at ($x+1, $y, my $checkbox = new DC::UI::CheckBox
1894 root 1.1 state => $::CFG->{pickup} & $mask,
1895     on_changed => sub {
1896     my ($box, $value) = @_;
1897    
1898     if ($value) {
1899     $::CFG->{pickup} |= $mask;
1900     } else {
1901     $::CFG->{pickup} &= ~$mask;
1902     }
1903    
1904 root 1.86 $::CONN->send_pickup ($::CFG->{pickup})
1905 root 1.1 if defined $::CONN;
1906    
1907     0
1908     });
1909    
1910     ${$_->[2]} = $checkbox if $_->[2];
1911     }
1912     }
1913    
1914 root 1.18 $table->add_at (2, 18, new DC::UI::ValSlider
1915 root 1.1 range => [$::CFG->{pickup} & 0xF, 0, 16, 1, 1],
1916     template => ">= 99",
1917 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).",
1918 root 1.1 to_value => sub { ">= " . 5 * $_[0] },
1919     on_changed => sub {
1920     my ($slider, $value) = @_;
1921    
1922     $::CFG->{pickup} &= ~0xF;
1923     $::CFG->{pickup} |= int $value
1924     if $value;
1925     1;
1926     });
1927    
1928 root 1.18 $table->add_at (3, 18, new DC::UI::Button
1929 root 1.1 text => "set",
1930     on_activate => sub {
1931 root 1.86 $::CONN->send_pickup ($::CFG->{pickup})
1932 root 1.1 if defined $::CONN;
1933     0
1934     });
1935    
1936     $r
1937     }
1938    
1939     my %SORT_ORDER = (
1940 elmex 1.41 type => sub {
1941     sort { $a->{type} <=> $b->{type} or $a->{name} cmp $b->{name} } @_
1942     },
1943 root 1.1 mtime => sub {
1944     my $NOW = time;
1945     sort {
1946     my $atime = $a->{mtime} - $NOW; $atime = $atime < 5 * 60 ? int $atime / 60 : 6;
1947     my $btime = $b->{mtime} - $NOW; $btime = $btime < 5 * 60 ? int $btime / 60 : 6;
1948    
1949     ($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED)
1950     or $btime <=> $atime
1951     or $a->{type} <=> $b->{type}
1952     } @_
1953     },
1954     weight => sub { sort {
1955     $a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1)
1956     or $a->{type} <=> $b->{type}
1957     } @_ },
1958     );
1959    
1960     sub inventory_widget {
1961 root 1.18 my $hb = new DC::UI::HBox homogeneous => 1;
1962 root 1.1
1963 root 1.18 $hb->add (my $vb1 = new DC::UI::VBox);
1964 root 1.22 $vb1->add (new DC::UI::Label text => "Player");
1965 root 1.1
1966 root 1.18 $vb1->add (my $hb1 = new DC::UI::HBox);
1967 root 1.1
1968     use sort 'stable';
1969    
1970 root 1.18 $hb1->add (new DC::UI::Selector
1971 root 1.1 value => $::CFG->{inv_sort},
1972     options => [
1973     [type => "Type/Name"],
1974     [mtime => "Recent/Normal/Locked"],
1975     [weight => "Weight/Type"],
1976     ],
1977     on_changed => sub {
1978     $::CFG->{inv_sort} = $_[1];
1979     $INV->set_sort_order ($SORT_ORDER{$_[1]});
1980     },
1981     );
1982 root 1.18 $hb1->add (new DC::UI::Label text => "Weight: ", align => 1, expand => 1);
1983 root 1.58 #TODO# update to weight/maxweight
1984 root 1.22 $hb1->add ($STATWIDS->{i_weight} = new DC::UI::Label align => 0);
1985 root 1.1
1986 root 1.18 $vb1->add (my $sw1 = new DC::UI::ScrolledWindow expand => 1, scroll_y => 1);
1987     $sw1->add ($INV = new DC::UI::Inventory);
1988 root 1.1 $INV->set_sort_order ($SORT_ORDER{$::CFG->{inv_sort}});
1989    
1990 root 1.18 $hb->add (my $vb2 = new DC::UI::VBox);
1991 root 1.1
1992 root 1.18 $vb2->add ($INVR_HB = new DC::UI::HBox);
1993 root 1.1
1994 root 1.18 $vb2->add (my $sw2 = new DC::UI::ScrolledWindow expand => 1, scroll_y => 1);
1995     $sw2->add ($INVR = new DC::UI::Inventory);
1996 root 1.1
1997     # XXX: Call after $INVR = ... because set_opencont sets the items
1998 root 1.18 DC::Protocol::set_opencont ($::CONN, 0, "Floor");
1999 root 1.1
2000     $hb
2001     }
2002    
2003     sub media_window {
2004 root 1.18 my $vb = new DC::UI::VBox;
2005 root 1.1
2006 root 1.18 $vb->add (new DC::UI::FancyFrame
2007 root 1.1 label => "Currently playing music",
2008 root 1.18 child => new DC::UI::ScrolledWindow scroll_x => 1, scroll_y => 0,
2009     child => ($MUSIC_PLAYING_WIDGET = new DC::UI::Label ellipsise => 0, fontsize => 0.8),
2010 root 1.1 );
2011    
2012 root 1.18 $vb->add (new DC::UI::FancyFrame
2013 root 1.1 label => "Other media used in this session",
2014     expand => 1,
2015 root 1.18 child => ($LICENSE_WIDGET = new DC::UI::TextScroller
2016 root 1.1 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4),
2017     );
2018    
2019     $vb
2020     }
2021    
2022     sub add_license {
2023     my ($meta) = @_;
2024    
2025     $meta = $meta->{data}
2026     or return;
2027    
2028     $meta->{license} || $meta->{author} || $meta->{source}
2029     or return;
2030    
2031     $LICENSE_WIDGET->add_paragraph ({
2032     fg => [1, 1, 1, 1],
2033     markup => "<small>"
2034 root 1.18 . "<b>Name:</b> " . (DC::asxml $meta->{name}) . "\n"
2035     . "<b>Author:</b> " . (DC::asxml $meta->{author}) . "\n"
2036     . "<b>Source:</b> " . (DC::asxml $meta->{source}) . "\n"
2037     . "<b>License:</b> " . (DC::asxml $meta->{license}) . "\n"
2038 root 1.1 . "</small>",
2039     });
2040     $LICENSE_WIDGET->scroll_to_bottom;
2041     }
2042    
2043     sub toggle_player_page {
2044     my ($widget) = @_;
2045    
2046     if ($PL_WINDOW->{visible} && $PL_NOTEBOOK->get_current_page == $widget) {
2047     $PL_WINDOW->hide;
2048     } else {
2049     $PL_NOTEBOOK->set_current_page ($widget);
2050     $PL_WINDOW->show;
2051     }
2052     }
2053    
2054 root 1.85 sub make_playerbook {
2055 root 1.18 my $plwin = $PL_WINDOW = new DC::UI::Toplevel
2056 root 1.1 x => "center",
2057     y => "center",
2058     force_w => $WIDTH * 9/10,
2059     force_h => $HEIGHT * 9/10,
2060     title => "Player",
2061     name => "playerbook",
2062     has_close_button => 1
2063     ;
2064    
2065     my $ntb =
2066     $PL_NOTEBOOK =
2067 root 1.18 new DC::UI::Notebook expand => 1;
2068 root 1.1
2069     $ntb->add_tab (
2070     "Statistics (F2)" => $STATS_PAGE = stats_window,
2071     "Shows statistics, where all your Stats and Resistances are shown."
2072     );
2073     $ntb->add_tab (
2074     "Skills (F3)" => $SKILL_PAGE = skill_window,
2075     "Shows all your Skills."
2076     );
2077    
2078 root 1.18 my $spellsw = $SPELL_PAGE = new DC::UI::ScrolledWindow (expand => 1, scroll_y => 1);
2079     $spellsw->add ($SPELL_LIST = new DC::UI::SpellList);
2080 root 1.1 $ntb->add_tab (
2081     "Spellbook (F4)" => $spellsw,
2082     "Displays all spells you have and lets you edit keyboard shortcuts for them."
2083     );
2084     $ntb->add_tab (
2085     "Inventory (F5)" => $INVENTORY_PAGE = inventory_widget,
2086     "Toggles the inventory window, where you can manage your loot (or treasures :). "
2087     . "You can also hit the <b>Tab</b>-key to show/hide the Inventory."
2088     );
2089     $ntb->add_tab (Pickup => $PICKUP_PAGE = autopickup_setup,
2090     "Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them.");
2091    
2092     $ntb->add_tab (Media => media_window,
2093     "License, Author and Source info for media sent by the server.");
2094    
2095     $ntb->set_current_page ($INVENTORY_PAGE);
2096    
2097     $plwin->add ($ntb);
2098     }
2099    
2100     sub keyboard_setup {
2101 root 1.18 DC::Macro::keyboard_setup
2102 root 1.1 }
2103    
2104 root 1.86 sub make_help_window {
2105 root 1.18 my $win = new DC::UI::Toplevel
2106 root 1.1 x => 'center',
2107     y => 'center',
2108     z => 4,
2109     name => 'doc_browser',
2110     force_w => int $WIDTH * 7/8,
2111     force_h => int $HEIGHT * 7/8,
2112     title => "Help Browser",
2113     has_close_button => 1;
2114    
2115 root 1.18 $win->add (my $vbox = new DC::UI::VBox);
2116 root 1.1
2117 root 1.18 $vbox->add (new DC::UI::FancyFrame
2118 root 1.1 label => "Navigation",
2119 root 1.18 child => (my $buttons = new DC::UI::HBox),
2120 root 1.1 );
2121 root 1.18 $vbox->add (my $viewer = new DC::UI::TextScroller
2122 root 1.1 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
2123    
2124     my @history;
2125     my @future;
2126     my $curnode;
2127    
2128     my $load_node; $load_node = sub {
2129     my ($node, $para) = @_;
2130    
2131     $buttons->clear;
2132    
2133 root 1.18 $buttons->add (new DC::UI::Button
2134 root 1.1 text => "⇤",
2135     tooltip => "back to the starting page",
2136     on_activate => sub {
2137     unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
2138     unshift @future, @history;
2139     @history = ();
2140     $load_node->(@{shift @future});
2141     },
2142     );
2143    
2144     if (@history) {
2145 root 1.18 $buttons->add (new DC::UI::Button
2146 root 1.1 text => "⋘",
2147 root 1.18 tooltip => "back to <i>" . (DC::asxml DC::Pod::full_path $history[-1][0]) . "</i>",
2148 root 1.1 on_activate => sub {
2149     unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
2150     $load_node->(@{pop @history});
2151     },
2152     );
2153     }
2154    
2155     if (@future) {
2156 root 1.18 $buttons->add (new DC::UI::Button
2157 root 1.1 text => "⋙",
2158 root 1.18 tooltip => "forward to <i>" . (DC::asxml DC::Pod::full_path $future[0][0]) . "</i>",
2159 root 1.1 on_activate => sub {
2160     push @history, [$curnode, $viewer->current_paragraph];
2161     $load_node->(@{shift @future});
2162     },
2163     );
2164     }
2165    
2166 root 1.18 $buttons->add (new DC::UI::Label text => " ");
2167 root 1.1
2168 root 1.18 my @path = DC::Pod::full_path_of $node;
2169 root 1.1 pop @path; # drop current node
2170    
2171     for my $node (@path) {
2172 root 1.18 $buttons->add (new DC::UI::Button
2173 root 1.31 text => $node->[DC::Pod::N_KW][0],
2174 root 1.18 tooltip => "go to <i>" . (DC::asxml DC::Pod::full_path $node) . "</i>",
2175 root 1.1 on_activate => sub {
2176     push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
2177     $load_node->($node);
2178     },
2179     );
2180 root 1.18 $buttons->add (new DC::UI::Label text => "/");
2181 root 1.1 }
2182    
2183 root 1.31 $buttons->add (new DC::UI::Label text => $node->[DC::Pod::N_KW][0], padding_x => 4, padding_y => 4);
2184 root 1.1
2185     $curnode = $node;
2186    
2187     $viewer->clear;
2188 root 1.18 $viewer->add_paragraph (DC::Pod::as_paragraphs DC::Pod::section_of $curnode);
2189 root 1.1 $viewer->scroll_to ($para);
2190     };
2191    
2192 root 1.18 $load_node->(DC::Pod::find pod => "mainpage");
2193 root 1.1
2194 root 1.18 $DC::Pod::goto_document = sub {
2195 root 1.1 my (@path) = @_;
2196    
2197     push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
2198    
2199 root 1.18 $load_node->((DC::Pod::find @path)[0]);
2200 root 1.1 $win->show;
2201     };
2202    
2203 root 1.86 $HELP_WINDOW = $win;
2204 root 1.1 }
2205    
2206     sub open_quit_dialog {
2207     unless ($QUIT_DIALOG) {
2208 root 1.18 $QUIT_DIALOG = new DC::UI::Toplevel
2209 root 1.1 x => "center",
2210     y => "center",
2211     z => 50,
2212     title => "Really Quit?",
2213     on_key_down => sub {
2214     my ($dialog, $ev) = @_;
2215     $ev->{sym} == 27 and $dialog->hide;
2216     }
2217     ;
2218    
2219 root 1.18 $QUIT_DIALOG->add (my $vb = new DC::UI::VBox expand => 1);
2220 root 1.1
2221 root 1.18 $vb->add (new DC::UI::Label
2222 root 1.1 text => "You should find a savebed and apply it first!",
2223     max_w => $WIDTH * 0.25,
2224     ellipsize => 0,
2225     );
2226 root 1.18 $vb->add (my $hb = new DC::UI::HBox expand => 1);
2227     $hb->add (new DC::UI::Button
2228 root 1.1 text => "Ok",
2229     expand => 1,
2230     on_activate => sub { $QUIT_DIALOG->hide; 0 },
2231     );
2232 root 1.18 $hb->add (new DC::UI::Button
2233 root 1.1 text => "Quit anyway",
2234     expand => 1,
2235 root 1.66 on_activate => sub {
2236     crash "Quit anyway";
2237     EV::unloop EV::UNLOOP_ALL;
2238     },
2239 root 1.1 );
2240     }
2241    
2242     $QUIT_DIALOG->show;
2243     $QUIT_DIALOG->grab_focus;
2244     }
2245    
2246 root 1.86 sub make_menubar {
2247 root 1.85 $MENUFRAME = new DC::UI::Toplevel
2248     border => 0,
2249     force_x => 0,
2250     force_y => 0,
2251     force_w => $::WIDTH,
2252     child => ($MENUBAR = new DC::UI::HBox),
2253     ;
2254    
2255     $MENUBAR->add ($BUTTONBAR = new DC::UI::Buttonbar);
2256    
2257     # 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
2258     make_gauge_window->show;
2259    
2260     # $BUTTONBAR->add (new DC::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW,
2261     # tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
2262    
2263     make_playerbook;
2264    
2265     $MENUPOPUP = DC::UI::Menu->new (items => [
2266 root 1.86 ["Setup…\tF9" , sub { $SETUP_DIALOG->toggle_visibility }],
2267     ["Playerbook…\tTab" , sub { $PL_WINDOW ->toggle_visibility }],
2268     ["…Statistics\tF2" , sub { toggle_player_page ($::STATS_PAGE) }],
2269     ["…Skills\tF3" , sub { toggle_player_page ($::SKILL_PAGE) }],
2270     ["…Spells\tF4" , sub { toggle_player_page ($::SPELL_PAGE) }],
2271     ["…Inventory\tF5" , sub { toggle_player_page ($::INVENTORY_PAGE) }],
2272     ["Help Browser…\tF1" , sub { $HELP_WINDOW ->toggle_visibility }],
2273     ["Quit…" , sub {
2274 root 1.85 if ($CONN) {
2275     open_quit_dialog;
2276     } else {
2277     EV::unloop EV::UNLOOP_ALL;
2278     }
2279     }],
2280     ]);
2281    
2282     $BUTTONBAR->add (new DC::UI::Button text => "Menu…",
2283     tooltip => "Shows the main menu",
2284 root 1.86 on_button_down => sub {
2285     my ($self, $ev) = @_;
2286     local $ev->{x} = 0;
2287     local $ev->{y} = 0;
2288     $MENUPOPUP->popup ($ev);
2289     },
2290 root 1.85 );
2291    
2292 root 1.86 $MENUBAR->add ($GAUGES->{exp} = new DC::UI::ExperienceProgress
2293 root 1.85 padding_x => 6,
2294     padding_y => 3,
2295 root 1.90 tooltip => "This progress bar shows your overall experience and your progress towards the next character level.",
2296 root 1.87 template => " Exp: 888,888,888,888 (lvl 188) ",
2297 root 1.85 );
2298 root 1.86
2299     $MENUBAR->add ($PICKUP_ENABLE = new DC::UI::CheckBox # checkbox bad, button better?
2300     tooltip => "Automatic Pickup Enable - when this checkbox is enabled, then your character "
2301     . "will automatically pick up items as defined by your item pickup settings "
2302     . "in the playerbook. Often (e.g. in apartments) you want to temporarily "
2303 root 1.89 . "disable autopickup by disabling this checkbox.",
2304 root 1.86 state => $CFG->{pickup} & PICKUP_INHIBIT ? 0 : 1,
2305     on_changed => sub {
2306     my ($self, $value) = @_;
2307     $CFG->{pickup} &= ~PICKUP_INHIBIT;
2308     $CFG->{pickup} |= PICKUP_INHIBIT unless $_[1];
2309     $CONN->send_pickup ($CFG->{pickup})
2310     if $CONN;
2311     },
2312 root 1.85 );
2313 root 1.86
2314     $MENUBAR->add ($GAUGES->{skillexp} = new DC::UI::ExperienceProgress
2315 root 1.85 c_rescale => 1,
2316     padding_x => 6,
2317     padding_y => 3,
2318     force_w => $::WIDTH * 0.2,
2319     tooltip => "This progress bar shows the currently used skill and your progress towards the next skill level of that skill.",
2320 root 1.86 template => "two handed weapons 99%",
2321 root 1.85 );
2322 root 1.86
2323 root 1.85 $MENUBAR->add ($GAUGES->{range} = new DC::UI::Label
2324     expand => 1,
2325     align => 1, can_hover => 1, can_events => 1,
2326     text => "Range and Combat Slots",
2327     tooltip => "#stat_ranged",
2328     );
2329    
2330     $MENUFRAME->show;
2331     }
2332    
2333     sub open_string_query {
2334     my ($title, $cb, $txt, $tooltip) = @_;
2335     my $dialog = new DC::UI::Toplevel
2336     x => "center",
2337     y => "center",
2338     z => 50,
2339     force_w => $WIDTH * 4/5,
2340     title => $title;
2341    
2342     $dialog->add (
2343     my $e = new DC::UI::Entry
2344     on_activate => sub { $cb->(@_); $dialog->hide; 0 },
2345     on_key_down => sub { $_[1]->{sym} == 27 and $dialog->hide; 0 },
2346     tooltip => $tooltip
2347     );
2348    
2349     $e->grab_focus;
2350     $e->set_text ($txt) if $txt;
2351     $dialog->show;
2352     }
2353    
2354 root 1.1 sub show_tip_of_the_day {
2355     # find all tips
2356 root 1.18 my @tod = DC::Pod::find tip_of_the_day => "*";
2357 root 1.1
2358 root 1.18 DC::DB::get state => "tip_of_the_day", sub {
2359 root 1.1 my ($todindex) = @_;
2360     $todindex = 0 if $todindex >= @tod;
2361 root 1.18 DC::DB::put state => tip_of_the_day => $todindex + 1, sub { };
2362 root 1.1
2363     # create dialog
2364     my $dialog;
2365    
2366     my $close = sub {
2367     $dialog->destroy;
2368     };
2369    
2370 root 1.18 $dialog = new DC::UI::Toplevel
2371 root 1.1 x => "center",
2372     y => "center",
2373     z => 3,
2374     name => 'tip_of_the_day',
2375     force_w => int $WIDTH * 4/9,
2376     force_h => int $WIDTH * 2/9,
2377     title => "Tip of the day #" . (1 + $todindex),
2378 root 1.18 child => my $vbox = new DC::UI::VBox,
2379 root 1.1 has_close_button => 1,
2380     on_delete => $close,
2381     ;
2382    
2383 root 1.18 $vbox->add (my $viewer = new DC::UI::TextScroller
2384 root 1.1 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
2385 root 1.18 $viewer->add_paragraph (DC::Pod::as_paragraphs DC::Pod::section_of $tod[$todindex]);
2386 root 1.1
2387 root 1.18 $vbox->add (my $table = new DC::UI::Table col_expand => [0, 1]);
2388 root 1.1
2389 root 1.18 $table->add_at (0, 0, new DC::UI::Button
2390 root 1.1 text => "Close",
2391     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>.",
2392     on_activate => $close,
2393     );
2394    
2395 root 1.18 $table->add_at (2, 0, new DC::UI::Button
2396 root 1.1 text => "Next",
2397     tooltip => "Show the next <b>Tip of the day</b>.",
2398     on_activate => sub {
2399     $close->();
2400     &show_tip_of_the_day;
2401     },
2402     );
2403    
2404     $dialog->show;
2405     };
2406     }
2407    
2408     sub sdl_init {
2409 root 1.52 DC::SDL_Init DC::SDL_INIT_AUDIO #| DC::SDL_NOPARACHUTE
2410 root 1.1 and die "SDL::Init failed!\n";
2411     }
2412    
2413     sub video_init {
2414 root 1.74 DC::set_theme $CFG->{uitheme};
2415 root 1.73
2416 root 1.52 DC::SDL_InitSubSystem DC::SDL_INIT_VIDEO if $SDL_REINIT;
2417     $SDL_REINIT = 0;
2418    
2419     @SDL_MODES = DC::SDL_ListModes 8, $CFG->{disable_alpha} ? 0 : 8;
2420     @SDL_MODES = DC::SDL_ListModes 8, 8 unless @SDL_MODES;
2421     @SDL_MODES = DC::SDL_ListModes 5, 0 unless @SDL_MODES;
2422     @SDL_MODES or DC::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
2423    
2424     @SDL_MODES = sort { $a->[0] * $a->[1] <=> $b->[0] * $b->[1] } @SDL_MODES;
2425    
2426 root 1.61 if (!defined $CFG->{sdl_mode} or $CFG->{sdl_mode} > $#SDL_MODES) {
2427     $CFG->{sdl_mode} = 0; # lowest resolution by default
2428    
2429 root 1.72 # now choose biggest mode <= 1024x768
2430 root 1.61 for (0 .. $#SDL_MODES) {
2431     if ($SDL_MODES[$_][0] * $SDL_MODES[$_][1] <= 1024 * 768) {
2432     $CFG->{sdl_mode} = $_;
2433     }
2434 root 1.52 }
2435     }
2436 root 1.1
2437     my ($old_w, $old_h) = ($WIDTH, $HEIGHT);
2438    
2439     ($WIDTH, $HEIGHT, my ($rgb, $alpha)) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
2440     $FULLSCREEN = $CFG->{fullscreen};
2441     $FAST = $CFG->{fast};
2442    
2443 root 1.59 # due to mac os x braindamage, we simply retry with !fullscreen in case of an error
2444 root 1.18 DC::SDL_SetVideoMode $WIDTH, $HEIGHT, $rgb, $alpha, $FULLSCREEN
2445 root 1.59 or DC::SDL_SetVideoMode $WIDTH, $HEIGHT, $rgb, $alpha, !$FULLSCREEN
2446 root 1.18 or die "SDL_SetVideoMode failed: " . (DC::SDL_GetError) . "\n";
2447 root 1.1
2448     $SDL_ACTIVE = 1;
2449     $LAST_REFRESH = time - 0.01;
2450    
2451 root 1.18 DC::OpenGL::init;
2452     DC::Macro::init;
2453 root 1.1
2454     $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
2455    
2456 root 1.18 $DC::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
2457 root 1.1
2458     #############################################################################
2459    
2460     if ($DEBUG_STATUS) {
2461 root 1.18 DC::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
2462 root 1.1 } else {
2463     # create/configure the widgets
2464    
2465 root 1.18 $DC::UI::ROOT->connect (key_down => sub {
2466 root 1.1 my (undef, $ev) = @_;
2467    
2468 root 1.18 if (my @macros = DC::Macro::find $ev) {
2469     DC::Macro::execute $_ for @macros;
2470 root 1.1
2471     return 1;
2472     }
2473    
2474     0
2475     });
2476    
2477 root 1.18 $DEBUG_STATUS = new DC::UI::Label
2478 root 1.1 padding => 0,
2479     z => 100,
2480     force_x => "max",
2481     force_y => 0;
2482     $DEBUG_STATUS->show;
2483    
2484 root 1.18 $STATUSBOX = new DC::UI::Statusbox;
2485 root 1.29
2486     $MODBOX = new DC::UI::Label
2487     can_events => 1,
2488     can_hover => 1,
2489     markup => "",
2490     align => 0,
2491     font => $FONT_FIXED,
2492 root 1.30 tooltip => "#modifier_box",
2493     tooltip_width => 0.67,
2494     ;
2495 root 1.29
2496     update_modbox;
2497 root 1.1
2498 root 1.18 (new DC::UI::Frame
2499 root 1.1 bg => [0, 0, 0, 0.4],
2500     force_x => 0,
2501     force_y => "max",
2502 root 1.85 child => (my $LL = new DC::UI::VBox),
2503 root 1.1 )->show;
2504    
2505 root 1.85 $LL->add ($STATUSBOX);
2506     $LL->add ($MODBOX);
2507     $LL->add (new DC::UI::Label
2508 root 1.29 align => 0,
2509     markup => "Use <b>Alt-Enter</b> to toggle fullscreen mode",
2510     fontsize => 0.5,
2511     fg => [1, 1, 0, 0.7],
2512     );
2513    
2514 root 1.18 DC::UI::Toplevel->new (
2515 root 1.2 title => "Minimap",
2516 root 1.1 name => "mapmap",
2517     x => 0,
2518 root 1.91 y => $::FONTSIZE + 8,#d# hack to move messages window below the menubar
2519 root 1.1 border_bg => [1, 1, 1, 192/255],
2520     bg => [1, 1, 1, 0],
2521 root 1.18 child => ($MAPMAP = new DC::MapWidget::MapMap
2522 root 1.75 tooltip => "<b>Minimap</b>. This will display an overview of the surrounding areas.",
2523 root 1.1 ),
2524     )->show;
2525    
2526 root 1.18 $MAPWIDGET = new DC::MapWidget;
2527 root 1.1 $MAPWIDGET->connect (activate_console => sub {
2528     my ($mapwidget, $preset) = @_;
2529    
2530 elmex 1.23 $MESSAGE_DIST->activate_console ($preset)
2531     if $MESSAGE_DIST;
2532 root 1.1 });
2533     $MAPWIDGET->show;
2534     $MAPWIDGET->grab_focus;
2535    
2536 root 1.18 $COMPLETER = new DC::MapWidget::Command::
2537 root 1.1 command => { },
2538     tooltip => "#completer_help",
2539     ;
2540    
2541 root 1.18 $SETUP_DIALOG = new DC::UI::Toplevel
2542 root 1.1 title => "Setup",
2543     name => "setup_dialog",
2544     x => 'center',
2545     y => 'center',
2546     z => 2,
2547     force_w => $::WIDTH * 0.6,
2548     force_h => $::HEIGHT * 0.6,
2549     has_close_button => 1,
2550     ;
2551    
2552     $METASERVER = metaserver_dialog;
2553 root 1.39 # the name is changed to not conflict with the older name as users could have hidden it
2554 root 1.40 $MESSAGE_WINDOW = new DC::UI::Dockbar
2555     name => "message_window2",
2556     title => 'Messages',
2557 root 1.91 y => $::FONTSIZE + 8,#d# hack to move messages window below the menubar
2558 root 1.40 force_w => $::WIDTH * 0.6,
2559     force_h => $::HEIGHT * 0.25,
2560     ;
2561    
2562 elmex 1.23 $MESSAGE_DIST = new DC::MessageDistributor dockbar => $MESSAGE_WINDOW;
2563 root 1.1
2564 root 1.38 $SETUP_DIALOG->add ($SETUP_NOTEBOOK = new DC::UI::Notebook expand => 1,
2565 root 1.18 filter => new DC::UI::ScrolledWindow expand => 1, scroll_y => 1);
2566 root 1.1
2567     $SETUP_NOTEBOOK->add_tab (Login => $SETUP_LOGIN = login_setup,
2568     "Configure the server to play on, your username and password.");
2569     $SETUP_NOTEBOOK->add_tab (Server => $SETUP_SERVER = server_setup,
2570     "Configure other server related options.");
2571     $SETUP_NOTEBOOK->add_tab (Client => client_setup,
2572     "Configure various client-specific settings.");
2573     $SETUP_NOTEBOOK->add_tab (Graphics => graphics_setup,
2574     "Configure the video mode, performance, fonts and other graphical aspects of the game.");
2575     $SETUP_NOTEBOOK->add_tab (Audio => audio_setup,
2576     "Configure the use of audio, sound effects and background music.");
2577     $SETUP_NOTEBOOK->add_tab (Keyboard => $SETUP_KEYBOARD = keyboard_setup,
2578     "Lets you define, edit and delete key bindings."
2579     . "There is a shortcut for making bindings: <b>Control-Insert</b> opens the binding editor "
2580     . "with nothing set and the recording started. After doing the actions you "
2581     . "want to record press <b>Insert</b> and you will be asked to press a key-combo. "
2582     . "After pressing the combo the binding will be saved automatically and the "
2583     . "binding editor closes");
2584     $SETUP_NOTEBOOK->add_tab (Debug => debug_setup,
2585     "Some debuggin' options. Do not ask.");
2586    
2587 root 1.86 make_help_window;
2588     make_menubar;
2589 root 1.1
2590     $SETUP_DIALOG->show;
2591     $MESSAGE_WINDOW->show;
2592     }
2593    
2594 root 1.72 $MODE_SLIDER->set_range ([$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1, 1]);
2595 root 1.53 $MODE_SLIDER->emit (changed => $CFG->{sdl_mode});
2596    
2597     $CAVEAT_LABEL->set_text ("None :)");
2598 root 1.97 $CAVEAT_LABEL->set_text ("Apple/NVIDIA Texture bug (slow)")
2599     if $DC::OpenGL::APPLE_NVIDIA_BUG;
2600 root 1.55 $CAVEAT_LABEL->set_text ("Software Rendering (very slow)")
2601 root 1.53 unless DC::SDL_GL_GetAttribute DC::SDL_GL_ACCELERATED_VISUAL;
2602    
2603 root 1.1 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
2604     }
2605    
2606     sub video_shutdown {
2607 root 1.18 DC::OpenGL::shutdown;
2608 root 1.52 DC::SDL_QuitSubSystem DC::SDL_INIT_VIDEO if $SDL_REINIT;
2609 root 1.1
2610     undef $SDL_ACTIVE;
2611     }
2612    
2613     my %animate_object;
2614     my $animate_timer;
2615    
2616     my $fps = 9;
2617    
2618     sub force_refresh {
2619     if ($ENV{CFPLUS_DEBUG} & 4) {
2620     $fps = $fps * 0.98 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.02;
2621     debug sprintf "%3.2f", $fps;
2622     }
2623    
2624 root 1.16 undef $WANT_REFRESH;
2625     $_[0]->stop;
2626 root 1.12
2627 root 1.18 $DC::UI::ROOT->draw;
2628     DC::SDL_GL_SwapBuffers;
2629 root 1.1 $LAST_REFRESH = $NOW;
2630     }
2631    
2632 root 1.19 my $want_refresh = EV::prepare_ns \&force_refresh;
2633 root 1.1
2634 root 1.19 my $input = EV::periodic 0, 1 / $MAX_FPS, undef, sub {
2635     $NOW = EV::now;
2636 root 1.1
2637 root 1.90 ($SDL_CB[$_->{type}] || sub { warn "unhandled event $_->{type}" })->($_)
2638 root 1.18 for DC::poll_events;
2639 root 1.1
2640     if (%animate_object) {
2641     $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
2642 root 1.16 $WANT_REFRESH = 1;
2643 root 1.1 }
2644 root 1.16
2645     $want_refresh->start
2646     if $WANT_REFRESH;
2647 root 1.4 };
2648 root 1.1
2649     sub animation_start {
2650     my ($widget) = @_;
2651     $animate_object{$widget} = $widget;
2652     }
2653    
2654     sub animation_stop {
2655     my ($widget) = @_;
2656     delete $animate_object{$widget};
2657     }
2658    
2659 root 1.90 $SDL_CB[DC::SDL_QUIT] = sub {
2660     crash "SDL_QUIT";
2661     EV::unloop EV::UNLOOP_ALL;
2662     };
2663     $SDL_CB[DC::SDL_VIDEORESIZE] = sub { };
2664     $SDL_CB[DC::SDL_VIDEOEXPOSE] = sub {
2665     DC::UI::full_refresh;
2666     };
2667     $SDL_CB[DC::SDL_ACTIVEEVENT] = sub {
2668     # not useful, as APPACTIVE includes only iconified state, not unmapped
2669     # printf "active %x %x %x\n", $_[0]{gain}, $_[0]{state}, DC::SDL_GetAppState;#d#
2670     # printf "a %x\n", DC::SDL_GetAppState & DC::SDL_APPACTIVE;#d#
2671     # printf "A\n" if $_[0]{state} & DC::SDL_APPACTIVE;
2672     # printf "K\n" if $_[0]{state} & DC::SDL_APPINPUTFOCUS;
2673     # printf "M\n" if $_[0]{state} & DC::SDL_APPMOUSEFOCUS;
2674     };
2675     $SDL_CB[DC::SDL_KEYDOWN] = sub {
2676     if ($_[0]{mod} & DC::KMOD_ALT && $_[0]{sym} == 13) {
2677     # alt-enter
2678     video_shutdown;
2679     $FULLSCREEN_ENABLE->toggle;
2680     video_init;
2681     } else {
2682     &DC::UI::feed_sdl_key_down_event;
2683     }
2684     update_modbox;
2685     };
2686     $SDL_CB[DC::SDL_KEYUP] = sub {
2687     &DC::UI::feed_sdl_key_up_event;
2688     update_modbox;
2689     };
2690     $SDL_CB[DC::SDL_MOUSEMOTION] = \&DC::UI::feed_sdl_motion_event,
2691     $SDL_CB[DC::SDL_MOUSEBUTTONDOWN] = \&DC::UI::feed_sdl_button_down_event,
2692     $SDL_CB[DC::SDL_MOUSEBUTTONUP] = \&DC::UI::feed_sdl_button_up_event,
2693     $SDL_CB[DC::SDL_USEREVENT] = sub {
2694     if ($_[0]{code} == 1) {
2695     audio_channel_finished $_[0]{data1};
2696     } elsif ($_[0]{code} == 0) {
2697     audio_music_finished;
2698     }
2699     };
2700 root 1.1
2701     #############################################################################
2702    
2703 root 1.11 $SIG{INT} = $SIG{TERM} = sub {
2704     EV::unloop;
2705     #d# TODO calling exit here hangs the process in some futex
2706     };
2707 root 1.1
2708 root 1.83 # due to mac os x + sdl combined braindamage, we need this contortion
2709 root 1.59 sub main {
2710     {
2711     DC::Pod::load_docwiki DC::find_rcfile "docwiki.pst";
2712 root 1.34
2713 root 1.59 if (-e "$Deliantra::VARDIR/client.cf") {
2714     DC::read_cfg "$Deliantra::VARDIR/client.cf";
2715     } else {
2716     #TODO: compatibility cruft
2717     DC::read_cfg "$Deliantra::OLDDIR/cfplusrc";
2718     print STDERR "INFO: used old configuration file\n";
2719     }
2720 root 1.15
2721 root 1.59 DC::DB::Server::run;
2722 root 1.35
2723 root 1.59 if ($CFG->{db_schema} < 1) {
2724     warn "INFO: upgrading database schema from 0 to 1, mapcache and tilecache will be lost\n";
2725     DC::DB::nuke_db;
2726     $CFG->{db_schema} = 1;
2727     DC::write_cfg;
2728     }
2729 root 1.35
2730 root 1.59 DC::DB::open_db;
2731 root 1.1
2732 root 1.59 DC::UI::set_layout ($::CFG->{layout});
2733 root 1.1
2734 root 1.59 my %DEF_CFG = (
2735 root 1.85 config_autosave => 1,
2736 root 1.61 sdl_mode => undef,
2737 root 1.59 fullscreen => 1,
2738     fast => 0,
2739     force_opengl11 => undef,
2740     disable_alpha => 0,
2741     smooth_movement => 1,
2742 root 1.98 smooth_transitions => 1,
2743 root 1.59 texture_compression => 1,
2744     map_scale => 1,
2745     fow_enable => 1,
2746     fow_intensity => 0,
2747 root 1.99 fow_texture => 0,
2748 root 1.59 map_smoothing => 1,
2749     gui_fontsize => 1,
2750     log_fontsize => 0.7,
2751     gauge_fontsize => 1,
2752     gauge_size => 0.35,
2753     stat_fontsize => 0.7,
2754     mapsize => 100,
2755     audio_enable => 1,
2756     audio_hw_channels => 0,
2757     audio_hw_frequency => 0,
2758     audio_hw_chunksize => 0,
2759     audio_mix_channels => 8,
2760     effects_enable => 1,
2761     effects_volume => 1,
2762     bgm_enable => 1,
2763     bgm_volume => 0.5,
2764     output_rate => "",
2765 root 1.86 pickup => PICKUP_SPELLBOOK | PICKUP_SKILLSCROLL | PICKUP_VALUABLES,
2766 root 1.59 inv_sort => "mtime",
2767     default => "profile", # default profile
2768     show_tips => 1,
2769     logview_max_par => 1000,
2770     shift_fire_stop => 0,
2771 root 1.74 uitheme => "wood",
2772 root 1.92 map_shift_x => -24, # arbitrary
2773     map_shift_y => +24, # arbitrary
2774 root 1.59 );
2775    
2776     while (my ($k, $v) = each %DEF_CFG) {
2777     $CFG->{$k} = $v unless exists $CFG->{$k};
2778     }
2779 root 1.1
2780 root 1.59 $CFG->{profile}{default}{host} ||= "gameserver.deliantra.net";
2781     $PROFILE = $CFG->{profile}{default};
2782 root 1.1
2783 root 1.59 # convert old bindings (only default profile matters)
2784     if (my $bindings = delete $PROFILE->{bindings}) {
2785     while (my ($mod, $syms) = each %$bindings) {
2786     while (my ($sym, $cmds) = each %$syms) {
2787     push @{ $PROFILE->{macro} }, {
2788     accelkey => [$mod*1, $sym*1],
2789     action => $cmds,
2790     };
2791     }
2792 root 1.1 }
2793     }
2794    
2795 root 1.59 sdl_init;
2796 root 1.1
2797 root 1.94 $ENV{FONTCONFIG_FILE} = DC::find_rcfile "fonts/fonts.conf";
2798     $ENV{FONTCONFIG_DIR} = DC::find_rcfile "fonts";
2799    
2800 root 1.59 {
2801     my @fonts = map DC::find_rcfile "fonts/$_", qw(
2802     DejaVuSans.ttf
2803     DejaVuSansMono.ttf
2804     DejaVuSans-Bold.ttf
2805     DejaVuSansMono-Bold.ttf
2806     DejaVuSans-Oblique.ttf
2807     DejaVuSansMono-Oblique.ttf
2808     DejaVuSans-BoldOblique.ttf
2809     DejaVuSansMono-BoldOblique.ttf
2810 root 1.94 mona.ttf
2811 root 1.59 );
2812    
2813     DC::add_font $_ for @fonts;
2814    
2815     $FONT_PROP = new_from_file DC::Font $fonts[0];
2816     $FONT_FIXED = new_from_file DC::Font $fonts[1];
2817 root 1.1
2818 root 1.59 $FONT_PROP->make_default;
2819 root 1.30
2820 root 1.59 DC::pango_init;
2821     }
2822 root 1.1
2823     # compare mono (ft) vs. rgba (cairo)
2824     # ft - 1.8s, cairo 3s, even in alpha-only mode
2825     # for my $rgba (0..1) {
2826     # my $t1 = Time::HiRes::time;
2827     # for (1..1000) {
2828 root 1.18 # my $layout = DC::Layout->new ($rgba);
2829 root 1.1 # $layout->set_text ("hallo" x 100);
2830     # $layout->render;
2831     # }
2832     # my $t2 = Time::HiRes::time;
2833     # warn $t2-$t1;
2834     # }
2835    
2836 root 1.59 video_init;
2837     audio_init;
2838     }
2839 root 1.1
2840 root 1.59 show_tip_of_the_day if $CFG->{show_tips};
2841 root 1.1
2842 root 1.59 our $STARTUP_CANCEL = EV::idle sub {
2843     undef $::STARTUP_CANCEL;
2844     $startup_done->();
2845     };
2846 root 1.1
2847 root 1.59 delete $SIG{__DIE__};
2848     EV::loop;
2849 root 1.1
2850 root 1.85 DC::write_cfg if $CFG->{config_autosave};
2851    
2852     #video_shutdown;
2853     #audio_shutdown;
2854    
2855 root 1.59 DC::OpenGL::quit;
2856     DC::SDL_Quit;
2857     DC::DB::Server::stop;
2858     }
2859    
2860     DC::SDL_braino; # see sub above
2861 root 1.1
2862     =head1 NAME
2863    
2864     deliantra - A Deliantra MORPG game client
2865    
2866     =head1 SYNOPSIS
2867    
2868     Just run it - no commandline arguments are supported.
2869    
2870     =head1 USAGE
2871    
2872     deliantra utilises OpenGL for all UI elements and the game. It is supposed to
2873     be used in fullscreen mode and interactively.
2874    
2875     =head1 DEBUGGING
2876    
2877    
2878     CFPLUS_DEBUG - environment variable
2879    
2880     1 draw borders around widgets
2881     2 add low-level widget info to tooltips
2882     4 show fps
2883     8 suppress tooltips
2884    
2885     =head1 AUTHOR
2886    
2887 root 1.57 Marc Lehmann <deliantra@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
2888 root 1.1
2889    
2890