ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cf.schmorp.de/Deliantra-Client/DC/Main.pm
Revision: 1.31
Committed: Mon Nov 19 00:56:08 2018 UTC (5 years, 7 months ago) by root
Branch: MAIN
CVS Tags: HEAD
Changes since 1.30: +2 -0 lines
Log Message:
*** empty log message ***

File Contents

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