ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/deliantra
Revision: 1.100
Committed: Tue Dec 22 01:37:42 2009 UTC (14 years, 6 months ago) by root
Branch: MAIN
CVS Tags: rel-2_10
Changes since 1.99: +2 -1 lines
Log Message:
bugfixes, also support ARB_multitexturing for low-end apple intel

File Contents

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