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