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