ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/deliantra
Revision: 1.85
Committed: Sun Jan 11 03:19:47 2009 UTC (15 years, 4 months ago) by root
Branch: MAIN
Changes since 1.84: +141 -90 lines
Log Message:
*** empty log message ***

File Contents

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