ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.203
Committed: Mon Aug 6 02:11:45 2007 UTC (16 years, 9 months ago) by root
Branch: MAIN
Changes since 1.202: +7 -5 lines
Log Message:
remove (the last|a) chokepoint in cfplus, logprint caused hangs on heavy disk i/o, e.g. when syncing the database data to disk

File Contents

# Content
1 #!/opt/bin/perl
2
3 my $startup_done = sub { };
4 our $PANGO = "1.5.0";
5
6 # do splash-screen thingy on win32
7 BEGIN {
8 if (%PAR::LibCache && $^O eq "MSWin32") {
9 while (my ($filename, $zip) = each %PAR::LibCache) {
10 $zip->extractMember ("SPLASH.bmp", "$ENV{PAR_TEMP}/SPLASH.bmp");
11 }
12
13 require Win32::GUI::SplashScreen;
14
15 Win32::GUI::SplashScreen::Show (
16 -file => "$ENV{PAR_TEMP}/SPLASH.bmp",
17 );
18
19 $startup_done = sub {
20 Win32::GUI::SplashScreen::Done (1);
21 };
22 }
23 }
24
25 use strict;
26 use utf8;
27
28 use Carp 'verbose';
29
30 # do things only needed for single-binary version (par)
31 BEGIN {
32 if (%PAR::LibCache) {
33 @INC = grep ref, @INC; # weed out all paths except pars loader refs
34
35 my $tmp = $ENV{PAR_TEMP};
36
37 while (my ($filename, $zip) = each %PAR::LibCache) {
38 for ($zip->memberNames) {
39 next unless /^root\/(.*)/;
40 $zip->extractMember ($_, "$tmp/$1")
41 unless -e "$tmp/$1";
42 }
43 }
44
45 if ($^O eq "MSWin32") {
46 # relocatable
47 } else {
48 # unix, need to patch pango rc file
49 open my $fh, "<:perlio", "$tmp/usr/lib/pango/$PANGO/module-files.d/libpango1.0-0.modules"
50 or die "$tmp/usr/lib/$PANGO/module-files.d/libpango1.0-0.modules: $!";
51 local $/;
52 my $rc = <$fh>;
53 $rc =~ s/^\//$tmp\//gm; # replace abs paths by relative ones
54
55 mkdir "$tmp/pango-modules";
56 open my $fh, ">:perlio", "$tmp/pango-modules/pango.modules"
57 or die "$tmp/pango-modules/pango.modules: $!";
58 print $fh $rc;
59
60 $ENV{PANGO_RC_FILE} = "$tmp/pango.rc";
61 open my $fh, ">:perlio", $ENV{PANGO_RC_FILE}
62 or die "$ENV{PANGO_RC_FILE}: $!";
63 print $fh "[Pango]\nModuleFiles = $tmp/pango-modules\n";
64 }
65
66 unshift @INC, $tmp;
67 }
68 }
69
70 # need to do it again because that pile of garbage called PAR nukes it before main
71 unshift @INC, $ENV{PAR_TEMP}
72 if %PAR::LibCache;
73
74 use Time::HiRes 'time';
75 use Event;
76 use List::Util qw(max min);
77
78 use Crossfire;
79 use Crossfire::Protocol::Constants;
80
81 use Compress::LZF;
82
83 use CFPlus;
84 use CFPlus::OpenGL ();
85 use CFPlus::Protocol;
86 use CFPlus::DB;
87 use CFPlus::UI;
88 use CFPlus::UI::Canvas;
89 use CFPlus::UI::Inventory;
90 use CFPlus::UI::SpellList;
91 use CFPlus::UI::MessageWindow;
92 use CFPlus::Pod;
93 use CFPlus::MapWidget;
94 use CFPlus::Macro;
95
96 $SIG{QUIT} = sub { Carp::cluck "QUIT" };
97 $SIG{PIPE} = 'IGNORE';
98
99 $Event::Eval = 1;
100 $Event::DIED = sub {
101 CFPlus::fatal Carp::longmess $_[1]
102 };
103
104 my $MAX_FPS = 60;
105 my $MIN_FPS = 5; # unused as of yet
106
107 our $META_SERVER = "http://metaserver.schmorp.de/current.json";
108
109 our $LAST_REFRESH;
110 our $NOW;
111
112 our $CFG;
113 our $CONN;
114 our $PROFILE; # current profile
115 our $FAST; # fast, low-quality mode, possibly useful for software-rendering
116
117 our $WANT_REFRESH;
118 our $CAN_REFRESH;
119
120 our @SDL_MODES;
121 our $WIDTH;
122 our $HEIGHT;
123 our $FULLSCREEN;
124 our $FONTSIZE;
125
126 our $FONT_PROP;
127 our $FONT_FIXED;
128
129 our $MAP;
130 our $MAPMAP;
131 our $MAPWIDGET;
132 our $BUTTONBAR;
133 our $METASERVER;
134 our $LOGIN_BUTTON;
135 our $QUIT_DIALOG;
136 our $HOST_ENTRY;
137 our $FULLSCREEN_ENABLE;
138 our $PICKUP_ENABLE;
139 our $SERVER_INFO;
140
141 our $SETUP_DIALOG;
142 our $SETUP_NOTEBOOK;
143 our $SETUP_SERVER;
144 our $SETUP_KEYBOARD;
145
146 our $PL_NOTEBOOK;
147 our $PL_WINDOW;
148
149 our $MUSIC_PLAYING_WIDGET;
150 our $LICENSE_WIDGET;
151
152 our $INVENTORY_PAGE;
153 our $STATS_PAGE;
154 our $SKILL_PAGE;
155 our $SPELL_PAGE;
156 our $SPELL_LIST;
157
158 our $HELP_WINDOW;
159 our $MESSAGE_WINDOW;
160 our $FLOORBOX;
161 our $GAUGES;
162 our $STATWIDS;
163
164 our $SDL_ACTIVE;
165 our %SDL_CB;
166
167 our $ALT_ENTER_MESSAGE;
168 our $STATUSBOX;
169 our $DEBUG_STATUS;
170
171 our $INV;
172 our $INVR;
173 our $INV_RIGHT_HB;
174
175 our $PICKUP_CFG;
176
177 #############################################################################
178
179 sub status {
180 $STATUSBOX->add (CFPlus::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
181 }
182
183 sub debug {
184 $DEBUG_STATUS->set_text ($_[0]);
185 }
186
187 sub message {
188 my ($para) = @_;
189 $MESSAGE_WINDOW->message ($para);
190 }
191
192 #############################################################################
193 #TODO: maybe move into own audio module...
194
195 our $SDL_MIXER;
196
197 our $MUSIC_DEFAULT = "in_a_heartbeat.ogg";
198 our $MUSIC_WANT; # arryref of ambient music we want to play
199 our @MUSIC_HAVE; # ambient music we have on disk
200 our $MUSIC_START;
201 our @MUSIC_JINGLE; # which jingles to play next
202 our $MUSIC_PLAYING_DATA;
203 our $MUSIC_PLAYING_META;
204 our $MUSIC_PLAYER;
205 our $MUSIC_RESUME = 30; # resume music when played less than these many seconds before
206
207 our %AUDIO_CHUNK; # audio "files"
208 our %AUDIO_PLAY; # which audio faces should be played
209
210 sub audio_channel_finished {
211 my ($channel) = @_;
212
213 # warn "channel $channel finished\n";#d#
214 }
215
216 sub audio_sound_push($) {
217 my ($face) = @_;
218
219 $CFG->{effects_enable}
220 or return;
221
222 if (my $chunk = $AUDIO_CHUNK{$face}) {
223 for (grep $_->[0] >= Event::time, @{(delete $AUDIO_PLAY{$face}) || []}) {
224 my (undef, $dx, $dy, $vol) = @$_;
225
226 my $channel = CFPlus::Channel::find;
227 $channel->volume ($vol * $CFG->{effects_volume} * 128 / 255);
228 $dx = $dx / 10 * 255;
229 $channel->set_panning (255 - $dx, 255 + $dx);
230
231 # my $angle = $dx ? : $dx < 0 ?
232 # my $distance = -$vol;
233 # $channel->set_position ($angle, $distance);
234
235 $chunk->play ($channel);
236 }
237 } else {
238 # sound_meta not set means data is in flight either way
239 my $meta = $CONN->{sound_meta}{$face}
240 or return;
241
242 # if its a jingle, play it as ambient music
243 if ($meta->{meta}{jingle}) {
244 if (delete $AUDIO_PLAY{$face}) { # take the jingle out of the sound queue
245 push @MUSIC_JINGLE, $meta; # push it oto the music/jingle queue
246 &audio_music_push ($face);
247 }
248 } else {
249 # fetch from database
250 CFPlus::DB::get res_data => $meta->{name}, sub {
251 my $rwops = new CFPlus::RW $_[0];
252 my $chunk = new CFPlus::MixChunk $rwops
253 or Carp::confess "sound face $meta->{face} unloadable: " . CFPlus::Mix_GetError;
254 $chunk->volume (($meta->{meta}{volume} || 1) * 128);
255 $AUDIO_CHUNK{$face} = $chunk;
256
257 audio_sound_push ($face);
258 };
259 }
260 }
261 }
262
263 sub audio_sound_play {
264 my ($face, $dx, $dy, $vol) = @_;
265
266 $SDL_MIXER
267 or return;
268 $CFG->{effects_enable}
269 or return;
270
271 my $queue = $AUDIO_PLAY{$face} ||= [];
272 push @$queue, [Event::time + 0.2, $dx, $dy, $vol]; # delay sound by max. 0.2s
273 audio_sound_push $face
274 unless @$queue > 1;
275 }
276
277 sub audio_music_set_meta {
278 my ($meta) = @_;
279
280 $MUSIC_PLAYING_META = $meta;
281 $MUSIC_PLAYING_WIDGET->set_markup (
282 "<b>Name</b>: " . (CFPlus::asxml $meta->{meta}{name}) . "\n"
283 . "<b>Author</b>: " . (CFPlus::asxml $meta->{meta}{author}) . "\n"
284 . "<b>Source</b>: " . (CFPlus::asxml $meta->{meta}{source}) . "\n"
285 . "<b>License</b>: " . (CFPlus::asxml $meta->{meta}{license})
286 );
287 }
288
289 sub audio_music_update_volume {
290 return unless $MUSIC_PLAYING_META;
291 my $volume = $MUSIC_PLAYING_META->{meta}{volume} || 1;
292 my $base = $MUSIC_PLAYING_META->{meta}{jingle} ? 1 : $CFG->{bgm_volume};
293 CFPlus::MixMusic::volume $base * $volume * 128;
294 }
295
296 sub audio_music_start {
297 my $meta = $MUSIC_PLAYING_META;
298
299 CFPlus::DB::get res_data => $meta->{name}, sub {
300 return unless $SDL_MIXER;
301
302 # music might have changed...
303 $meta eq $MUSIC_PLAYING_META
304 or return &audio_music_start ();
305
306 audio_music_update_volume;
307
308 $MUSIC_PLAYING_DATA = \$_[0];
309
310 my $rwops = $meta->{path}
311 ? new_from_file CFPlus::RW $meta->{path}
312 : new CFPlus::RW $$MUSIC_PLAYING_DATA;
313
314 $MUSIC_PLAYER = new CFPlus::MixMusic $rwops
315 or Carp::confess "music face $meta->{face} unloadable: " . CFPlus::Mix_GetError;
316
317 my $NOW = time;
318
319 if ($MUSIC_PLAYING_META->{stop_time} > $NOW - $MUSIC_RESUME) {
320 my $pos = $MUSIC_PLAYING_META->{stop_pos};
321 $MUSIC_PLAYER->fade_in_pos (0, 1000, $pos);
322 $MUSIC_START = time - $pos;
323 } else {
324 $MUSIC_PLAYER->play (0);
325 $MUSIC_START = time;
326 }
327
328 delete $meta->{stop_time};
329 delete $meta->{stop_pos};
330 }
331 }
332
333 sub audio_music_push {
334 return unless $SDL_MIXER;
335
336 my $fade_out;
337
338 if (@MUSIC_JINGLE) {
339 @MUSIC_HAVE = $MUSIC_JINGLE[0];
340 $fade_out = 333;
341 } else {
342 return unless $CFG->{bgm_enable};
343
344 my @have =
345 grep $_,
346 map $CONN->{music_meta}{$_},
347 @$MUSIC_WANT;
348
349 @MUSIC_HAVE = @have
350 if @have;
351
352 # default MUSIC_HAVE == MUSIC_DEFAULT
353 @MUSIC_HAVE = { path => CFPlus::find_rcfile "music/$MUSIC_DEFAULT" } unless @MUSIC_HAVE;
354 $fade_out = 1000;
355 }
356
357 # if the currently playing song is acceptable, let it continue
358 return if grep $MUSIC_PLAYING_META == $_, @MUSIC_HAVE;
359
360 my $NOW = time;
361
362 if ($MUSIC_PLAYING_META) {
363 $MUSIC_PLAYING_META->{stop_time} = $NOW;
364 $MUSIC_PLAYING_META->{stop_pos} = $NOW - $MUSIC_START;
365 CFPlus::MixMusic::fade_out $fade_out;
366 } else {
367 # sort by stop time, oldest first
368 @MUSIC_HAVE = sort { $a->{stop_time} <=> $b->{stop_time} } @MUSIC_HAVE;
369
370 # if the most recently-played piece played very recently,
371 # resume it, else choose the oldest piece for rotation.
372 audio_music_set_meta
373 $MUSIC_HAVE[-1]{stop_time} > $NOW - $MUSIC_RESUME
374 ? $MUSIC_HAVE[-1]
375 : $MUSIC_HAVE[0];
376
377 audio_music_start;
378 }
379 }
380
381 sub audio_music_set_ambient {
382 my ($songs) = @_;
383
384 $MUSIC_WANT = $songs;
385 audio_music_push;
386 }
387
388 sub audio_music_finished {
389 # we compress multiple jingles of the same type
390 shift @MUSIC_JINGLE
391 while @MUSIC_JINGLE && $MUSIC_PLAYING_META == $MUSIC_JINGLE[0];
392
393 $MUSIC_PLAYING_WIDGET->clear;
394
395 undef $MUSIC_PLAYER;
396 undef $MUSIC_PLAYING_META;
397 undef $MUSIC_PLAYING_DATA;
398
399 audio_music_push;
400 }
401
402 sub audio_init {
403 if ($CFG->{audio_enable}) {
404 $ENV{MIX_EFFECTSMAXSPEED} = 1;
405 $SDL_MIXER = !CFPlus::Mix_OpenAudio;
406
407 unless ($SDL_MIXER) {
408 status "Unable to open sound device: there will be no sound";
409 return;
410 }
411
412 CFPlus::Mix_AllocateChannels 16;
413
414 audio_music_finished;
415 } else {
416 undef $SDL_MIXER;
417 }
418 }
419
420 sub audio_shutdown {
421 undef $MUSIC_PLAYER;
422 undef $MUSIC_PLAYING_META;
423 undef $MUSIC_PLAYING_DATA;
424
425 audio_music_set_meta { };
426
427 $MUSIC_WANT = [];
428 @MUSIC_JINGLE = ();
429 %AUDIO_PLAY = ();
430 %AUDIO_CHUNK = ();
431
432 CFPlus::Mix_CloseAudio if $SDL_MIXER;
433 undef $SDL_MIXER;
434 }
435
436 #############################################################################
437
438 sub destroy_query_dialog {
439 (delete $_[0]{query_dialog})->destroy
440 if $_[0]{query_dialog};
441 }
442
443 # FIXME: a very ugly hack to wait for stat update look below! #d#
444 our $QUERY_TIMER; #d#
445
446 # server query dialog
447 sub server_query {
448 my ($conn, $flags, $prompt) = @_;
449
450 # FIXME: a very ugly hack to wait for stat update #d#
451 if ($prompt =~ /roll new stats/ and not $conn->{stat_change_with}) {
452 unless ($QUERY_TIMER) {
453 $QUERY_TIMER =
454 Event->timer (
455 after => 1,
456 cb => sub {
457 server_query ($conn, $flags, $prompt, 1);
458 $QUERY_TIMER = undef
459 }
460 );
461 return;
462 }
463 }
464
465 $conn->{query_dialog} = my $dialog = new CFPlus::UI::Toplevel
466 x => "center",
467 y => "center",
468 title => "Server Query",
469 child => my $vbox = new CFPlus::UI::VBox,
470 ;
471
472 my @dialog = my $label = new CFPlus::UI::Label
473 max_w => $::WIDTH * 0.8,
474 ellipsise => 0,
475 text => $prompt;
476
477 if ($flags & CS_QUERY_YESNO) {
478 push @dialog, my $hbox = new CFPlus::UI::HBox;
479
480 $hbox->add (new CFPlus::UI::Button
481 text => "No",
482 on_activate => sub {
483 $conn->send ("reply n");
484 $dialog->destroy;
485 0
486 }
487 );
488 $hbox->add (new CFPlus::UI::Button
489 text => "Yes",
490 on_activate => sub {
491 $conn->send ("reply y");
492 destroy_query_dialog $conn;
493 0
494 },
495 );
496
497 $dialog->grab_focus;
498
499 } elsif ($flags & CS_QUERY_SINGLECHAR) {
500 if ($prompt =~ /Now choose a character|Press any key for the next race/i) {
501 $dialog->{tooltip} = "#charcreation_focus";
502
503 unshift @dialog, new CFPlus::UI::Label
504 max_w => $::WIDTH * 0.8,
505 ellipsise => 0,
506 markup => "\nOr use your keyboard and the text entry below:\n";
507
508 unshift @dialog, my $table = new CFPlus::UI::Table;
509
510 $table->add_at (0, 0, new CFPlus::UI::Button
511 text => "Next Race",
512 on_activate => sub {
513 $conn->send ("reply n");
514 destroy_query_dialog $conn;
515 0
516 },
517 );
518 $table->add_at (2, 0, new CFPlus::UI::Button
519 text => "Accept",
520 on_activate => sub {
521 $conn->send ("reply d");
522 destroy_query_dialog $conn;
523 0
524 },
525 );
526
527 if ($conn->{chargen_race_description}) {
528 unshift @dialog, new CFPlus::UI::Label
529 max_w => $::WIDTH * 0.8,
530 ellipsise => 0,
531 markup => "<span foreground='#ccccff'>$conn->{chargen_race_description}</span>",
532 ;
533 }
534
535 unshift @dialog, new CFPlus::UI::Face
536 face => $conn->{player}{face},
537 bg => [.2, .2, .2, 1],
538 min_w => 64,
539 min_h => 64,
540 ;
541
542 if ($conn->{chargen_race_title}) {
543 unshift @dialog, new CFPlus::UI::Label
544 allign => 1,
545 ellipsise => 0,
546 markup => "<span foreground='#ccccff' size='large'>Race: $conn->{chargen_race_title}</span>",
547 ;
548 }
549
550 unshift @dialog, new CFPlus::UI::Label
551 max_w => $::WIDTH * 0.4,
552 ellipsise => 0,
553 markup => (CFPlus::Pod::section_label ui => "chargen_race"),
554 ;
555
556 } elsif ($prompt =~ /roll new stats/) {
557 if (my $stat = delete $conn->{stat_change_with}) {
558 $conn->send ("reply $stat");
559 destroy_query_dialog $conn;
560 return;
561 }
562
563 unshift @dialog, new CFPlus::UI::Label
564 max_w => $::WIDTH * 0.4,
565 ellipsise => 0,
566 markup => "\nOr use your keyboard and the text entry below:\n";
567
568 unshift @dialog, my $table = new CFPlus::UI::Table;
569
570 # left: re-roll
571 $table->add_at (0, 0, new CFPlus::UI::Button
572 text => "Roll Again",
573 on_activate => sub {
574 $conn->send ("reply y");
575 destroy_query_dialog $conn;
576 0
577 },
578 );
579
580 # center: swap stats
581 my ($sw1, $sw2) = map +(new CFPlus::UI::Selector
582 expand => 1,
583 value => $_,
584 options => [
585 [1 => "Str", "Strength ($conn->{stat}{+CS_STAT_STR})"],
586 [2 => "Dex", "Dexterity ($conn->{stat}{+CS_STAT_DEX})"],
587 [3 => "Con", "Constitution ($conn->{stat}{+CS_STAT_CON})"],
588 [4 => "Int", "Intelligence ($conn->{stat}{+CS_STAT_INT})"],
589 [5 => "Wis", "Wisdom ($conn->{stat}{+CS_STAT_WIS})"],
590 [6 => "Pow", "Power ($conn->{stat}{+CS_STAT_POW})"],
591 [7 => "Cha", "Charisma ($conn->{stat}{+CS_STAT_CHA})"],
592 ],
593 ), 1 .. 2;
594
595 $table->add_at (2, 0, new CFPlus::UI::Button
596 text => "Swap Stats",
597 on_activate => sub {
598 $conn->{stat_change_with} = $sw2->{value};
599 $conn->send ("reply $sw1->{value}");
600 destroy_query_dialog $conn;
601 0
602 },
603 );
604 $table->add_at (2, 1, new CFPlus::UI::HBox children => [$sw1, $sw2]);
605
606 # right: accept
607 $table->add_at (4, 0, new CFPlus::UI::Button
608 text => "Accept",
609 on_activate => sub {
610 $conn->send ("reply n");
611 $STATS_PAGE->hide;
612 destroy_query_dialog $conn;
613 0
614 },
615 );
616
617 unshift @dialog, my $hbox = new CFPlus::UI::HBox;
618 for (
619 [Str => CS_STAT_STR],
620 [Dex => CS_STAT_DEX],
621 [Con => CS_STAT_CON],
622 [Int => CS_STAT_INT],
623 [Wis => CS_STAT_WIS],
624 [Pow => CS_STAT_POW],
625 [Cha => CS_STAT_CHA],
626 ) {
627 my ($name, $id) = @$_;
628 $hbox->add (new CFPlus::UI::Label
629 markup => "$conn->{stat}{$id} <span foreground='yellow'>$name</span>",
630 align => 0,
631 expand => 1,
632 can_events => 1,
633 can_hover => 1,
634 tooltip => "#stat_$name",
635 );
636 }
637
638 unshift @dialog, new CFPlus::UI::Label
639 max_w => $::WIDTH * 0.4,
640 ellipsise => 0,
641 markup => (CFPlus::Pod::section_label ui => "chargen_stats"),
642 ;
643 }
644
645 push @dialog, my $entry = new CFPlus::UI::Entry
646 on_changed => sub {
647 $conn->send ("reply $_[1]");
648 destroy_query_dialog $conn;
649 0
650 },
651 ;
652
653 $entry->grab_focus;
654
655 } else {
656 $dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)";
657
658 push @dialog, my $entry = new CFPlus::UI::Entry
659 $flags & CS_QUERY_HIDEINPUT ? (hidden => "*") : (),
660 on_activate => sub {
661 $conn->send ("reply $_[1]");
662 destroy_query_dialog $conn;
663 0
664 },
665 ;
666
667 $entry->grab_focus;
668 }
669
670 $vbox->add (@dialog);
671 $dialog->show;
672 }
673
674 sub start_game {
675 status "logging in...";
676
677 $LOGIN_BUTTON->set_text ("Logout");
678 $SETUP_DIALOG->hide;
679
680 my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
681
682 my ($host, $port) = split /:/, $PROFILE->{host};
683
684 $MAP = new CFPlus::Map;
685
686 $CONN = eval {
687 new CFPlus::Protocol
688 host => $host,
689 port => $port || 13327,
690 user => $PROFILE->{user},
691 pass => $PROFILE->{password},
692 mapw => $mapsize,
693 maph => $mapsize,
694
695 client => "cfplus $CFPlus::VERSION $] $^O",
696
697 map_widget => $MAPWIDGET,
698 statusbox => $STATUSBOX,
699 map => $MAP,
700 mapmap => $MAPMAP,
701 query => \&server_query,
702
703 setup_req => {
704 smoothing => $CFG->{map_smoothing}*1,
705 },
706 };
707
708 if ($CONN) {
709 CFPlus::lowdelay fileno $CONN->{fh};
710
711 status "login successful";
712 } else {
713 status "unable to connect";
714 stop_game();
715 }
716 }
717
718 sub stop_game {
719 $LOGIN_BUTTON->set_text ("Login");
720 $SETUP_NOTEBOOK->set_current_page ($SETUP_SERVER);
721 $SETUP_DIALOG->show;
722 $PL_WINDOW->hide;
723 $SPELL_LIST->clear_spells;
724 $CFPlus::UI::ROOT->emit (stop_game => ! ! $CONN);
725
726 &audio_music_set_ambient ([]);
727
728 return unless $CONN;
729
730 status "connection closed";
731
732 destroy_query_dialog $CONN;
733 $CONN->destroy;
734 $CONN = 0; # false, does not autovivify
735
736 undef $MAP;
737 }
738
739 sub graphics_setup {
740 my $vbox = new CFPlus::UI::VBox;
741
742 $vbox->add (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]);
743
744 my $row = 0;
745
746 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "OpenGL Info");
747 $table->add_at (1, $row++, new CFPlus::UI::Label valign => 0, fontsize => 0.8, text => CFPlus::OpenGL::gl_vendor . ", " . CFPlus::OpenGL::gl_version,
748 can_events => 1,
749 tooltip => "<tt><span size='8192'>" . (CFPlus::OpenGL::gl_extensions) . "</span></tt>");
750
751 my $vidmode_tooltip =
752 "<b>Video Mode.</b> The video mode to use for fullscreen (and the window size for windowed operation). "
753 . "The format is <i>width</i> x <i>height</i> \@ <i>depth-per-channel</i> + <i>alpha-channel</i>.";
754
755 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Video Mode");
756 $table->add_at (1, $row++, my $hbox = new CFPlus::UI::HBox);
757
758 $hbox->add (my $mode_slider = new CFPlus::UI::Slider
759 force_w => $WIDTH * 0.1, expand => 1, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1],
760 tooltip => $vidmode_tooltip);
761 $hbox->add (my $mode_label = new CFPlus::UI::Label
762 align => 0, valign => 0, height => 0.8, template => "9999x9999@9+9",
763 can_events => 1, tooltip => $vidmode_tooltip);
764
765 $mode_slider->connect (changed => sub {
766 my ($self, $value) = @_;
767
768 $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value;
769 $mode_label->set_text (sprintf '%dx%d@%d+%d', @{$SDL_MODES[$value]});
770 });
771 $mode_slider->emit (changed => $mode_slider->{range}[0]);
772
773 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fullscreen");
774 $table->add_at (1, $row++, $FULLSCREEN_ENABLE = new CFPlus::UI::CheckBox
775 state => $CFG->{fullscreen},
776 tooltip => "Bring the client into fullscreen mode.",
777 on_changed => sub { my ($self, $value) = @_; $CFG->{fullscreen} = $value; 0 }
778 );
779
780 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
781 $table->add_at (1, $row++, new CFPlus::UI::CheckBox
782 state => $CFG->{fast},
783 tooltip => "Lower the visual quality considerably to speed up rendering.",
784 on_changed => sub { my ($self, $value) = @_; $CFG->{fast} = $value; 0 }
785 );
786
787 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
788 $table->add_at (1, $row++, new CFPlus::UI::Slider
789 range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1],
790 tooltip => "The base font size used by most GUI elements that do not have their own setting.",
791 on_changed => sub { $CFG->{gui_fontsize} = $_[1]; 0 },
792 );
793
794 $table->add_at (1, $row++, new CFPlus::UI::Button
795 expand => 1, align => 0, text => "Apply",
796 tooltip => "Apply the video settings above.",
797 on_activate => sub {
798 video_shutdown ();
799 video_init ();
800 0
801 }
802 );
803
804 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Scale");
805 $table->add_at (1, $row++, new CFPlus::UI::Slider
806 range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
807 tooltip => "Enlarge or shrink the displayed map. Changes are instant.",
808 on_changed => sub { my ($self, $value) = @_; $CFG->{map_scale} = 2 ** $value; 0 }
809 );
810
811 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Smoothing");
812 $table->add_at (1, $row++, new CFPlus::UI::CheckBox
813 state => $CFG->{map_smoothing},
814 tooltip => "<b>Map Smoothing</b> tries to make tile borders less square. "
815 . "This increases load on the graphics subsystem and works only with 2.x servers. "
816 . "Changes take effect at next connection only.",
817 on_changed => sub { my ($self, $value) = @_; $CFG->{map_smoothing} = $value; 0 }
818 );
819
820 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fog of War");
821 $table->add_at (1, $row++, new CFPlus::UI::CheckBox
822 state => $CFG->{fow_enable},
823 tooltip => "<b>Fog-of-War</b> marks areas that cannot be seen by the player. Changes are instant.",
824 on_changed => sub { my ($self, $value) = @_; $CFG->{fow_enable} = $value; 0 }
825 );
826
827 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "FoW Intensity");
828 $table->add_at (1, $row++, new CFPlus::UI::Slider
829 range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256],
830 tooltip => "<b>Fog of War Lightness.</b> The higher the intensity, the lighter the Fog-of-War color. Changes are instant.",
831 on_changed => sub { my ($self, $value) = @_; $CFG->{fow_intensity} = $value; 0 }
832 );
833
834 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Message Fontsize");
835 $table->add_at (1, $row++, new CFPlus::UI::Slider
836 range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1],
837 tooltip => "The font size used by the <b>message/server log</b> window only. Changes are instant.",
838 on_changed => sub { $MESSAGE_WINDOW->set_fontsize ($CFG->{log_fontsize} = $_[1]); 0 },
839 );
840
841 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Gauge fontsize");
842 $table->add_at (1, $row++, new CFPlus::UI::Slider
843 range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1],
844 tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.",
845 on_changed => sub {
846 $CFG->{gauge_fontsize} = $_[1];
847 &set_gauge_window_fontsize;
848 0
849 }
850 );
851
852 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Gauge size");
853 $table->add_at (1, $row++, new CFPlus::UI::Slider
854 range => [$CFG->{gauge_size}, 0.2, 0.8],
855 tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",
856 on_changed => sub {
857 $CFG->{gauge_size} = $_[1];
858 $GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
859 0
860 }
861 );
862
863 $vbox
864 }
865
866 sub audio_setup {
867 my $vbox = new CFPlus::UI::VBox;
868
869 $vbox->add (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 0, 1]);
870
871 my $row = 0;
872
873 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Audio Enable");
874 $table->add_at (1, $row++, new CFPlus::UI::CheckBox
875 state => $CFG->{audio_enable},
876 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.",
877 on_changed => sub { $CFG->{audio_enable} = $_[1]; 0 }
878 );
879 # $table->add_at (0, 9, new CFPlus::UI::Label valign => 0, align => 1, text => "Effects Volume");
880 # $table->add_at (1, 8, new CFPlus::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], on_changed => sub {
881 # $CFG->{effects_volume} = $_[1];
882 # });
883
884 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Effects Volume");
885 $table->add_at (1, $row, new CFPlus::UI::CheckBox
886 expand => 1, state => $CFG->{effects_enable},
887 tooltip => "If enabled, sound effects are enabled. If disabled, no sound effects will be played.",
888 on_changed => sub { $CFG->{effects_enable} = $_[1]; 0 }
889 );
890 $table->add_at (2, $row++, new CFPlus::UI::Slider
891 expand => 1, range => [$CFG->{effects_volume}, 0, 1, 0, 1/128],
892 tooltip => "The relative volume of sound effects. Best audio quality is achieved if this "
893 . "is set highest and you use your operating system volume setting. Changes are instant.",
894 on_changed => sub { $CFG->{effects_volume} = $_[1]; 0 }
895 );
896
897 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Background Music");
898 $table->add_at (1, $row, new CFPlus::UI::CheckBox
899 expand => 1, state => $CFG->{bgm_enable},
900 tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.",
901 on_changed => sub { $CFG->{bgm_enable} = $_[1]; 0 }
902 );
903 $table->add_at (2, $row++, new CFPlus::UI::Slider
904 expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],
905 tooltip => "The volume of the background music. Changes are instant.",
906 on_changed => sub { $CFG->{bgm_volume} = $_[1]; audio_music_update_volume; 0 }
907 );
908
909 $table->add_at (1, $row++, new CFPlus::UI::Button
910 c_colspan => 2, expand => 1, align => 0, text => "Apply",
911 tooltip => "Apply the audio settings",
912 on_activate => sub {
913 audio_shutdown ();
914 audio_init ();
915 0
916 }
917 );
918
919 $vbox
920 }
921
922 sub set_gauge_window_fontsize {
923 for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) {
924 $_->set_fontsize ($::CFG->{gauge_fontsize});
925 }
926 }
927
928 sub make_gauge_window {
929 my $gh = int $HEIGHT * $CFG->{gauge_size};
930
931 my $win = new CFPlus::UI::Frame (
932 force_x => 0,
933 force_y => "max",
934 force_w => $WIDTH,
935 force_h => $gh,
936 );
937
938 $win->add (my $hbox = new CFPlus::UI::HBox
939 children => [
940 (new CFPlus::UI::HBox expand => 1),
941 (new CFPlus::UI::VBox children => [
942 (new CFPlus::UI::Empty expand => 1),
943 (new CFPlus::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new CFPlus::UI::Table)),
944 ]),
945 (my $vbox = new CFPlus::UI::VBox),
946 ],
947 );
948
949 $vbox->add (new CFPlus::UI::HBox
950 expand => 1,
951 children => [
952 (new CFPlus::UI::Empty expand => 1),
953 (my $hb = new CFPlus::UI::HBox),
954 ],
955 );
956
957 $hb->add (my $hg = new CFPlus::UI::Gauge type => 'hp', tooltip => "#stat_health");
958 $hb->add (my $mg = new CFPlus::UI::Gauge type => 'mana', tooltip => "#stat_mana");
959 $hb->add (my $gg = new CFPlus::UI::Gauge type => 'grace', tooltip => "#stat_grace");
960 $hb->add (my $fg = new CFPlus::UI::Gauge type => 'food', tooltip => "#stat_food");
961
962 $vbox->add (my $exp = new CFPlus::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1, tooltip => "#stat_exp");
963 $vbox->add (my $rng = new CFPlus::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1, tooltip => "#stat_ranged");
964
965 $GAUGES = {
966 exp => $exp, win => $win, range => $rng,
967 food => $fg, mana => $mg, hp => $hg, grace => $gg
968 };
969
970 &set_gauge_window_fontsize;
971
972 $win
973 }
974
975 sub debug_setup {
976 my $table = new CFPlus::UI::Table;
977
978 $table->add_at (0, 0, new CFPlus::UI::Label text => "Widget Borders");
979 $table->add_at (1, 0, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 1; 0 });
980 $table->add_at (0, 1, new CFPlus::UI::Label text => "Tooltip Widget Info");
981 $table->add_at (1, 1, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 2; 0 });
982 $table->add_at (0, 2, new CFPlus::UI::Label text => "Show FPS");
983 $table->add_at (1, 2, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 4; 0 });
984 $table->add_at (0, 3, new CFPlus::UI::Label text => "Suppress Tooltips");
985 $table->add_at (1, 3, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 8; 0 });
986 $table->add_at (0, 4, new CFPlus::UI::Button text => "die on click(tm)", on_activate => sub { &CFPlus::debug() } );
987
988 $table->add_at (0, 5, new CFPlus::UI::TextEdit text => "line1\0152\0153");#d#
989
990 $table->add_at (7,7, my $t = new CFPlus::UI::Table expand => 0);
991 $t->add_at (0,0, new CFPlus::UI::Label text => "a a a a", c_rowspan => 1, c_colspan => 2);
992 $t->add_at (2,0, new CFPlus::UI::Label text => "b\nb", c_rowspan => 2, c_colspan => 1);
993 $t->add_at (1,2, new CFPlus::UI::Label text => "c c c c", c_rowspan => 1, c_colspan => 2);
994 $t->add_at (0,1, new CFPlus::UI::Label text => "d\nd", c_rowspan => 2, c_colspan => 1);
995 $t->add_at (1,1, new CFPlus::UI::Label text => "e");
996
997 $table->add_at (7, 6, my $c = new CFPlus::UI::Canvas);
998
999 $c->add_items ({
1000 type => "line_loop",
1001 color => [0, 1, 0],
1002 width => 9,
1003 coord_mode => "abs",
1004 coord => [[10, 5], [5, 50], [20, 5], [5, 60]],
1005 });
1006
1007 $c->add_items ({
1008 type => "lines",
1009 color => [1, 1, 0],
1010 width => 2,
1011 coord_mode => "rel",
1012 coord => [[0,0], [1,1], [1,0], [0,1]],
1013 });
1014
1015 $c->add_items ({
1016 type => "polygon",
1017 color => [0, 0.43, 0],
1018 width => 2,
1019 coord_mode => "rel",
1020 coord => [[0,0.2], [1,.4], [1,.6], [0,.8]],
1021 });
1022
1023 $table
1024 }
1025
1026 sub stats_window {
1027 my $r = new CFPlus::UI::ScrolledWindow (
1028 expand => 1,
1029 scroll_y => 1
1030 );
1031 $r->add (my $vb = new CFPlus::UI::VBox);
1032
1033 $vb->add (new CFPlus::UI::FancyFrame
1034 label => "Player",
1035 child => (my $pi = new CFPlus::UI::VBox),
1036 );
1037
1038 $pi->add ($STATWIDS->{title} = new CFPlus::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,
1039 can_hover => 1, can_events => 1,
1040 tooltip => "Your name and title. You can change your title by using the <b>title</b> command, if supported by the server.");
1041 $pi->add ($STATWIDS->{map} = new CFPlus::UI::Label valign => 0, align => -1, text => "Map:", expand => 1,
1042 can_hover => 1, can_events => 1,
1043 tooltip => "The map you are currently on (if supported by the server).");
1044
1045 $pi->add (my $hb0 = new CFPlus::UI::HBox);
1046 $hb0->add ($STATWIDS->{weight} = new CFPlus::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1,
1047 can_hover => 1, can_events => 1,
1048 tooltip => "The weight of the player including all inventory items.");
1049 $hb0->add ($STATWIDS->{m_weight} = new CFPlus::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1,
1050 can_hover => 1, can_events => 1,
1051 tooltip => "The weight limit: you cannot carry more than this.");
1052
1053 $vb->add (new CFPlus::UI::FancyFrame
1054 label => "Primary/Secondary Statistics",
1055 child => (my $hb = new CFPlus::UI::HBox expand => 1),
1056 );
1057 $hb->add (my $tbl = new CFPlus::UI::Table expand => 1);
1058
1059 my $color2 = [1, 1, 0];
1060
1061 for (
1062 [0, 0, st_str => "Str", 30],
1063 [0, 1, st_dex => "Dex", 30],
1064 [0, 2, st_con => "Con", 30],
1065 [0, 3, st_int => "Int", 30],
1066 [0, 4, st_wis => "Wis", 30],
1067 [0, 5, st_pow => "Pow", 30],
1068 [0, 6, st_cha => "Cha", 30],
1069
1070 [2, 0, st_wc => "Wc", -120],
1071 [2, 1, st_ac => "Ac", -120],
1072 [2, 2, st_dam => "Dam", 120],
1073 [2, 3, st_arm => "Arm", 120],
1074 [2, 4, st_spd => "Spd", 10.54],
1075 [2, 5, st_wspd => "WSp", 10.54],
1076 ) {
1077 my ($col, $row, $id, $label, $template) = @$_;
1078
1079 $tbl->add_at ($col , $row, $STATWIDS->{$id} = new CFPlus::UI::Label
1080 font => $FONT_FIXED, can_hover => 1, can_events => 1, valign => 0,
1081 align => +1, template => $template, tooltip => "#stat_$label");
1082 $tbl->add_at ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFPlus::UI::Label
1083 font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $color2, valign => 0,
1084 align => -1, text => $label, tooltip => "#stat_$label");
1085 }
1086
1087 $vb->add (new CFPlus::UI::FancyFrame
1088 label => "Resistancies",
1089 child => (my $tbl2 = new CFPlus::UI::Table expand => 1),
1090 );
1091
1092 my $row = 0;
1093 my $col = 0;
1094
1095 my %resist_names = (
1096 slow => ["Slow",
1097 "<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.)"],
1098 holyw => ["Holy Word",
1099 "<b>Holy Word</b> (resistance you against getting the fear when someone whose god doesn't like you spells the holy word on you.)"],
1100 conf => ["Confusion",
1101 "<b>Confusion</b> (If you are hit by confusion you will move into random directions, and likely into monsters.)"],
1102 fire => ["Fire",
1103 "<b>Fire</b> (just your resistance to fire spells like burning hands, dragonbreath, meteor swarm fire, ...)"],
1104 depl => ["Depletion",
1105 "<b>Depletion</b> (some monsters and other effects can cause stats depletion)"],
1106 magic => ["Magic",
1107 "<b>Magic</b> (resistance to magic spells like magic missile or similar)"],
1108 drain => ["Draining",
1109 "<b>Draining</b> (some monsters (e.g. vampires) and other effects can steal experience)"],
1110 acid => ["Acid",
1111 "<b>Acid</b> (resistance to acid, acid hurts pretty much and also corrodes your weapons)"],
1112 pois => ["Poison",
1113 "<b>Poison</b> (resistance to getting poisoned)"],
1114 para => ["Paralysation",
1115 "<b>Paralysation</b> (this resistance affects the chance you get paralysed)"],
1116 deat => ["Death",
1117 "<b>Death</b> (resistance against death spells)"],
1118 phys => ["Physical",
1119 "<b>Physical</b> (this is the resistance against physical attacks, like when a monster hit you in melee combat. The value displayed here is also displayed in the 'Arm' field on the left.)"],
1120 blind => ["Blind",
1121 "<b>Blind</b> (blind resistance affects the chance of a successful blinding attack)"],
1122 fear => ["Fear",
1123 "<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)"],
1124 tund => ["Turn undead",
1125 "<b>Turn undead</b> (affects your resistancy to various forms of 'turn undead' spells. Only relevant when you are, in fact, undead..."],
1126 elec => ["Electricity",
1127 "<b>Electricity</b> (resistance against electricity, spells like large lightning, small lightning, ...)"],
1128 cold => ["Cold",
1129 "<b>Cold</b> (this is your resistance against cold spells like icestorm, snowstorm, ...)"],
1130 ghit => ["Ghost hit",
1131 "<b>Ghost hit</b> (special attack used by ghosts and ghost-like beings)"],
1132 );
1133
1134 for (qw/slow holyw conf fire depl magic
1135 drain acid pois para deat phys
1136 blind fear tund elec cold ghit/)
1137 {
1138 $tbl2->add_at ($col, $row,
1139 $STATWIDS->{"res_$_"} =
1140 new CFPlus::UI::Label
1141 font => $FONT_FIXED,
1142 template => "-100%",
1143 align => +1,
1144 valign => 0,
1145 can_events => 1,
1146 can_hover => 1,
1147 tooltip => $resist_names{$_}->[1],
1148 );
1149 $tbl2->add_at ($col + 1, $row, new CFPlus::UI::Image
1150 font => $FONT_FIXED,
1151 can_hover => 1,
1152 can_events => 1,
1153 path => "ui/resist/resist_$_.png",
1154 tooltip => $resist_names{$_}->[1],
1155 );
1156 $tbl2->add_at ($col + 2, $row, new CFPlus::UI::Label
1157 text => $resist_names{$_}->[0],
1158 font => $FONT_FIXED,
1159 can_hover => 1,
1160 can_events => 1,
1161 tooltip => $resist_names{$_}->[1],
1162 );
1163
1164 $row++;
1165 if ($row % 6 == 0) {
1166 $col += 3;
1167 $row = 0;
1168 }
1169 }
1170
1171 #update_stats_window ({});
1172
1173 $r
1174 }
1175
1176 sub skill_window {
1177 my $sw = new CFPlus::UI::ScrolledWindow (expand => 1);
1178 $sw->add ($STATWIDS->{skill_tbl} = new CFPlus::UI::Table expand => 1, col_expand => [0, 0, 1, 0, 0, 1]);
1179 $sw
1180 }
1181
1182 sub formsep($) {
1183 scalar reverse join ",", unpack "(A3)*", reverse $_[0] * 1
1184 }
1185
1186 my $METASERVER_ATIME;
1187
1188 sub update_metaserver {
1189 my ($metaserver_dialog) = @_;
1190
1191 $METASERVER = $metaserver_dialog
1192 if defined $metaserver_dialog;
1193
1194 return if $METASERVER_ATIME > time;
1195 $METASERVER_ATIME = time + 60;
1196
1197 my $table = $METASERVER->{table};
1198 $table->clear;
1199 $table->add_at (0, 0, my $label = new CFPlus::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list...");
1200
1201 my $ok = 0;
1202
1203 CFPlus::background {
1204 my $ua = CFPlus::lwp_useragent;
1205
1206 CFPlus::background_msg CFPlus::from_json +(CFPlus::lwp_check $ua->get ($META_SERVER))->decoded_content;
1207 } sub {
1208 my ($msg) = @_;
1209 if ($msg) {
1210 $table->clear;
1211
1212 my @tip = (
1213 "The current number of users logged in on the server.",
1214 "The hostname of the server.",
1215 "The time this server has been running without being restarted.",
1216 "The server software version - a '+' indicates a Crossfire+ server.",
1217 "Short information about this server provided by its admins.",
1218 );
1219 my @col = qw(#Users Host Uptime Version Description);
1220 $table->add_at ($_, 0, new CFPlus::UI::Label
1221 can_hover => 1, can_events => 1,
1222 align => 0, fg => [1, 1, 0],
1223 text => $col[$_], tooltip => $tip[$_])
1224 for 0 .. $#col;
1225
1226 my @align = qw(1 0 1 1 -1);
1227
1228 my $y = 0;
1229 for my $m (@{ $msg->{servers} }) {
1230 my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime, $highlight) =
1231 @$m{qw(ip age hostname users version description ibytes obytes uptime highlight)};
1232
1233 for ($desc) {
1234 s/<br>/\n/gi;
1235 s/<li>/\n· /gi;
1236 s/<.*?>//sgi;
1237 s/&amp;/&/g;
1238 s/&lt;/</g;
1239 s/&gt;/>/g;
1240 }
1241
1242 $uptime = sprintf "%dd %02d:%02d:%02d",
1243 (int $uptime / 86400),
1244 (int $uptime / 3600) % 24,
1245 (int $uptime / 60) % 60,
1246 $uptime % 60;
1247
1248 $m = [$users, $host, $uptime, $version, $desc];
1249
1250 $y++;
1251
1252 $table->add_at (scalar @$m, $y, new CFPlus::UI::VBox children => [
1253 (new CFPlus::UI::Button
1254 text => "Use",
1255 tooltip => "Put this server into the <b>Host:Port</b> field",
1256 on_activate => sub {
1257 $HOST_ENTRY->set_text ($CFG->{profile}{default}{host} = $host);
1258 $METASERVER->hide;
1259 0
1260 },
1261 ),
1262 (new CFPlus::UI::Empty expand => 1),
1263 ]);
1264
1265 $table->add_at ($_, $y, new CFPlus::UI::Label
1266 max_w => $::WIDTH * 0.4,
1267 ellipsise => 0,
1268 align => $align[$_],
1269 text => $m->[$_],
1270 tooltip => $tip[$_],
1271 fg => ($highlight ? [1, 1, 1] : [.7, .7, .7]),
1272 can_hover => 1,
1273 can_events => 1,
1274 fontsize => 0.8)
1275 for 0 .. $#$m;
1276 }
1277 } else {
1278 $ok or $label->set_text ("error while contacting metaserver");
1279 }
1280 };
1281
1282 }
1283
1284 sub metaserver_dialog {
1285 my $vbox = new CFPlus::UI::VBox;
1286 my $table = new CFPlus::UI::Table;
1287 $vbox->add (new CFPlus::UI::ScrolledWindow expand => 1, child => $table);
1288
1289 my $dialog = new CFPlus::UI::Toplevel
1290 title => "Server List",
1291 name => 'metaserver_dialog',
1292 x => 'center',
1293 y => 'center',
1294 z => 3,
1295 force_w => $::WIDTH * 0.9,
1296 force_h => $::HEIGHT * 0.7,
1297 child => $vbox,
1298 has_close_button => 1,
1299 table => $table,
1300 on_visibility_change => sub {
1301 update_metaserver ($_[0]) if $_[1];
1302 0
1303 },
1304 ;
1305
1306 $dialog
1307 }
1308
1309 sub server_setup {
1310 my $vbox = new CFPlus::UI::VBox;
1311
1312 $vbox->add (new CFPlus::UI::FancyFrame
1313 label => "Connection Settings",
1314 child => (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]),
1315 );
1316 $table->add_at (0, 2, new CFPlus::UI::Label valign => 0, align => 1, text => "Host:Port");
1317
1318 {
1319 $table->add_at (1, 2, my $vbox = new CFPlus::UI::VBox);
1320
1321 $vbox->add (
1322 $HOST_ENTRY = new CFPlus::UI::Entry
1323 expand => 1,
1324 text => $CFG->{profile}{default}{host},
1325 tooltip => "The hostname or ip address of the Crossfire(+) server to connect to",
1326 on_changed => sub {
1327 my ($self, $value) = @_;
1328 $CFG->{profile}{default}{host} = $value;
1329 1
1330 }
1331 );
1332
1333 $vbox->add (new CFPlus::UI::Button
1334 expand => 1,
1335 text => "Server List",
1336 other => $METASERVER,
1337 tooltip => "Show a list of available crossfire servers",
1338 on_activate => sub { $METASERVER->toggle_visibility; 0 },
1339 on_visibility_change => sub { $METASERVER->hide unless $_[1]; 1 },
1340 );
1341 }
1342
1343 $table->add_at (0, 4, new CFPlus::UI::Label valign => 0, align => 1, text => "Username");
1344 $table->add_at (1, 4, new CFPlus::UI::Entry
1345 text => $CFG->{profile}{default}{user},
1346 tooltip => "The name of your character on the server",
1347 on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{user} = $value; 1 }
1348 );
1349
1350 $table->add_at (0, 5, new CFPlus::UI::Label valign => 0, align => 1, text => "Password");
1351 $table->add_at (1, 5, new CFPlus::UI::Entry
1352 text => $CFG->{profile}{default}{password},
1353 hidden => 1,
1354 tooltip => "The password for your character",
1355 on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{password} = $value; 1 }
1356 );
1357
1358 $table->add_at (0, 7, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Size");
1359 $table->add_at (1, 7, new CFPlus::UI::Slider
1360 force_w => 100,
1361 range => [$CFG->{mapsize}, 10, 100, 0, 1],
1362 tooltip => "This is the size of the portion of the map update the server sends you. "
1363 . "If you set this to a high value you will be able to see further, "
1364 . "but you also increase bandwidth requirements and latency. "
1365 . "This option is only used once at log-in.",
1366 on_changed => sub { my ($self, $value) = @_; $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 1 },
1367 );
1368
1369 $table->add_at (0, 8, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Rate");
1370 $table->add_at (1, 8, new CFPlus::UI::Entry
1371 text => $CFG->{output_rate},
1372 tooltip => "The maximum bandwidth in bytes per second that the server should not exceed "
1373 . "when sending data. When 0 or unset, the server "
1374 . "default will be used, which is usually around 100kb/s. Most servers will "
1375 . "dynamically find an optimal rate, so adjust this only when necessary.",
1376 on_changed => sub { $CFG->{output_rate} = $_[1]; 1 },
1377 );
1378
1379 $table->add_at (0, 9, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Count");
1380 $table->add_at (1, 9, new CFPlus::UI::Entry
1381 text => $CFG->{output_count},
1382 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
1383 on_changed => sub { $CFG->{output_count} = $_[1]; 1 },
1384 );
1385
1386 $table->add_at (0, 10, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Sync");
1387 $table->add_at (1, 10, new CFPlus::UI::Entry
1388 text => $CFG->{output_sync},
1389 tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.",
1390 on_changed => sub { $CFG->{output_sync} = $_[1]; 1 },
1391 );
1392
1393 $table->add_at (1, 11, $LOGIN_BUTTON = new CFPlus::UI::Button
1394 expand => 1,
1395 align => 0,
1396 text => "Login",
1397 on_activate => sub {
1398 $CONN ? stop_game
1399 : start_game;
1400 1
1401 },
1402 );
1403
1404 $vbox->add (new CFPlus::UI::FancyFrame
1405 label => "Server Info",
1406 child => ($SERVER_INFO = new CFPlus::UI::Label ellipsise => 0),
1407 );
1408
1409 $vbox
1410 }
1411
1412 sub client_setup {
1413 my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1];
1414
1415 my $row = 0;
1416
1417 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Tip of the day");
1418 $table->add_at (1, $row++, new CFPlus::UI::CheckBox
1419 state => $CFG->{show_tips},
1420 tooltip => "Show the <b>Tip of the day</b> window at startup?",
1421 on_changed => sub {
1422 my ($self, $value) = @_;
1423 $CFG->{show_tips} = $value;
1424 0
1425 }
1426 );
1427
1428 $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Messages Window Size");
1429 $table->add_at (1, $row++, my $saycmd = new CFPlus::UI::Entry
1430 text => $CFG->{logview_max_par},
1431 tooltip => "This is maximum number of messages remembered in the <b>Messages</b> window. If the server "
1432 . "sends more messages than this number, older messages get removed to save memory and "
1433 . "computing time. A value of <b>0</b> disables this feature, but that is not recommended.",
1434 on_changed => sub {
1435 my ($self, $value) = @_;
1436 $MESSAGE_WINDOW->set_max_para ($CFG->{logview_max_par} = $value*1);
1437 0
1438 },
1439 );
1440
1441 $table
1442 }
1443
1444 sub autopickup_setup {
1445 my $r = new CFPlus::UI::ScrolledWindow (
1446 expand => 1,
1447 scroll_y => 1
1448 );
1449 $r->add (my $table = new CFPlus::UI::Table
1450 row_expand => [0],
1451 col_expand => [0, 1, 0, 1],
1452 );
1453
1454 for (
1455 ["General", 0, 0,
1456 ["Enable autopickup" => PICKUP_NEWMODE, \$PICKUP_ENABLE],
1457 ["Inhibit autopickup" => PICKUP_INHIBIT],
1458 ["Stop before pickup" => PICKUP_STOP],
1459 ["Debug autopickup" => PICKUP_DEBUG],
1460 ],
1461 ["Weapons", 0, 6,
1462 ["All weapons" => PICKUP_ALLWEAPON],
1463 ["Missile weapons" => PICKUP_MISSILEWEAPON],
1464 ["Bows" => PICKUP_BOW],
1465 ["Arrows" => PICKUP_ARROW],
1466 ],
1467 ["Armour", 0, 12,
1468 ["Helmets" => PICKUP_HELMET],
1469 ["Shields" => PICKUP_SHIELD],
1470 ["Body Armour" => PICKUP_ARMOUR],
1471 ["Boots" => PICKUP_BOOTS],
1472 ["Gloves" => PICKUP_GLOVES],
1473 ["Cloaks" => PICKUP_CLOAK],
1474 ],
1475
1476 ["Readables", 2, 0,
1477 ["Spellbooks" => PICKUP_SPELLBOOK],
1478 ["Skillscrolls" => PICKUP_SKILLSCROLL],
1479 ["Normal Books/Scrolls" => PICKUP_READABLES],
1480 ],
1481 ["Misc", 2, 5,
1482 ["Food" => PICKUP_FOOD],
1483 ["Drinks" => PICKUP_DRINK],
1484 ["Valuables (Money, Gems)" => PICKUP_VALUABLES],
1485 ["Keys" => PICKUP_KEY],
1486 ["Magical Items" => PICKUP_MAGICAL],
1487 ["Potions" => PICKUP_POTION],
1488 ["Magic Devices" => PICKUP_MAGIC_DEVICE],
1489 ["Ignore cursed" => PICKUP_NOT_CURSED],
1490 ["Jewelery" => PICKUP_JEWELS],
1491 ["Flesh" => PICKUP_FLESH],
1492 ],
1493 ["Weight/Value ratio", 2, 17]
1494 )
1495 {
1496 my ($title, $x, $y, @bits) = @$_;
1497 $table->add_at ($x, $y, new CFPlus::UI::Label text => $title, align => 1, fg => [1, 1, 0]);
1498
1499 for (@bits) {
1500 ++$y;
1501
1502 my $mask = $_->[1];
1503 $table->add_at ($x , $y, new CFPlus::UI::Label text => $_->[0], align => 1, expand => 1);
1504 $table->add_at ($x+1, $y, my $checkbox = new CFPlus::UI::CheckBox
1505 state => $::CFG->{pickup} & $mask,
1506 on_changed => sub {
1507 my ($box, $value) = @_;
1508
1509 if ($value) {
1510 $::CFG->{pickup} |= $mask;
1511 } else {
1512 $::CFG->{pickup} &= ~$mask;
1513 }
1514
1515 $::CONN->send_command ("pickup $::CFG->{pickup}")
1516 if defined $::CONN;
1517
1518 0
1519 });
1520
1521 ${$_->[2]} = $checkbox if $_->[2];
1522 }
1523 }
1524
1525 $table->add_at (2, 18, new CFPlus::UI::ValSlider
1526 range => [$::CFG->{pickup} & 0xF, 0, 16, 1, 1],
1527 template => ">= 99",
1528 to_value => sub { ">= " . 5 * $_[0] },
1529 on_changed => sub {
1530 my ($slider, $value) = @_;
1531
1532 $::CFG->{pickup} &= ~0xF;
1533 $::CFG->{pickup} |= int $value
1534 if $value;
1535 1;
1536 });
1537
1538 $table->add_at (3, 18, new CFPlus::UI::Button
1539 text => "set",
1540 on_activate => sub {
1541 $::CONN->send_command ("pickup $::CFG->{pickup}")
1542 if defined $::CONN;
1543 0
1544 });
1545
1546 $r
1547 }
1548
1549 my %SORT_ORDER = (
1550 type => undef,
1551 mtime => sub {
1552 my $NOW = time;
1553 sort {
1554 my $atime = $a->{mtime} - $NOW; $atime = $atime < 5 * 60 ? int $atime / 60 : 6;
1555 my $btime = $b->{mtime} - $NOW; $btime = $btime < 5 * 60 ? int $btime / 60 : 6;
1556
1557 ($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED)
1558 or $btime <=> $atime
1559 or $a->{type} <=> $b->{type}
1560 } @_
1561 },
1562 weight => sub { sort {
1563 $a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1)
1564 or $a->{type} <=> $b->{type}
1565 } @_ },
1566 );
1567
1568 sub inventory_widget {
1569 my $hb = new CFPlus::UI::HBox homogeneous => 1;
1570
1571 $hb->add (my $vb1 = new CFPlus::UI::VBox);
1572 $vb1->add (new CFPlus::UI::Label align => 0, text => "Player");
1573
1574 $vb1->add (my $hb1 = new CFPlus::UI::HBox);
1575
1576 use sort 'stable';
1577
1578 $hb1->add (new CFPlus::UI::Selector
1579 value => $::CFG->{inv_sort},
1580 options => [
1581 [type => "Type/Name"],
1582 [mtime => "Recent/Normal/Locked"],
1583 [weight => "Weight/Type"],
1584 ],
1585 on_changed => sub {
1586 $::CFG->{inv_sort} = $_[1];
1587 $INV->set_sort_order ($SORT_ORDER{$_[1]});
1588 },
1589 );
1590 $hb1->add (new CFPlus::UI::Label text => "Weight: ", align => 1, expand => 1);
1591 #TODO# update to weigh/maxweight
1592 $hb1->add ($STATWIDS->{i_weight} = new CFPlus::UI::Label align => -1);
1593
1594 $vb1->add (my $sw1 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);
1595 $sw1->add ($INV = new CFPlus::UI::Inventory);
1596 $INV->set_sort_order ($SORT_ORDER{$::CFG->{inv_sort}});
1597
1598 $hb->add (my $vb2 = new CFPlus::UI::VBox);
1599
1600 $vb2->add ($INV_RIGHT_HB = new CFPlus::UI::HBox);
1601
1602 $vb2->add (my $sw2 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);
1603 $sw2->add ($INVR = new CFPlus::UI::Inventory);
1604
1605 # XXX: Call after $INVR = ... because set_opencont sets the items
1606 CFPlus::Protocol::set_opencont ($::CONN, 0, "Floor");
1607
1608 $hb
1609 }
1610
1611 sub media_window {
1612 my $vb = new CFPlus::UI::VBox;
1613
1614 $vb->add (new CFPlus::UI::FancyFrame
1615 label => "Currently playing music",
1616 child => new CFPlus::UI::ScrolledWindow scroll_x => 1, scroll_y => 0,
1617 child => ($MUSIC_PLAYING_WIDGET = new CFPlus::UI::Label ellipsise => 0, fontsize => 0.8),
1618 );
1619
1620 $vb->add (new CFPlus::UI::FancyFrame
1621 label => "Other media used in this session",
1622 expand => 1,
1623 child => ($LICENSE_WIDGET = new CFPlus::UI::TextScroller
1624 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4),
1625 );
1626
1627 $vb
1628 }
1629
1630 sub add_license {
1631 my ($meta) = @_;
1632
1633 $meta = $meta->{meta}
1634 or return;
1635
1636 $meta->{license} || $meta->{author} || $meta->{source}
1637 or return;
1638
1639 $LICENSE_WIDGET->add_paragraph ({
1640 fg => [1, 1, 1, 1],
1641 markup => "<small>"
1642 . "<b>Name:</b> " . (CFPlus::asxml $meta->{name}) . "\n"
1643 . "<b>Author:</b> " . (CFPlus::asxml $meta->{author}) . "\n"
1644 . "<b>Source:</b> " . (CFPlus::asxml $meta->{source}) . "\n"
1645 . "<b>License:</b> " . (CFPlus::asxml $meta->{license}) . "\n"
1646 . "</small>",
1647 });
1648 $LICENSE_WIDGET->scroll_to_bottom;
1649 }
1650
1651 sub toggle_player_page {
1652 my ($widget) = @_;
1653
1654 if ($PL_WINDOW->{visible} && $PL_NOTEBOOK->get_current_page == $widget) {
1655 $PL_WINDOW->hide;
1656 } else {
1657 $PL_NOTEBOOK->set_current_page ($widget);
1658 $PL_WINDOW->show;
1659 }
1660 }
1661
1662 sub player_window {
1663 my $plwin = $PL_WINDOW = new CFPlus::UI::Toplevel
1664 x => "center",
1665 y => "center",
1666 force_w => $WIDTH * 9/10,
1667 force_h => $HEIGHT * 9/10,
1668 title => "Player",
1669 name => "playerbook",
1670 has_close_button => 1
1671 ;
1672
1673 my $ntb =
1674 $PL_NOTEBOOK =
1675 new CFPlus::UI::Notebook expand => 1;
1676
1677 $ntb->add_tab (
1678 "Statistics (F2)" => $STATS_PAGE = stats_window,
1679 "Shows statistics, where all your Stats and Resistances are shown."
1680 );
1681 $ntb->add_tab (
1682 "Skills (F3)" => $SKILL_PAGE = skill_window,
1683 "Shows all your Skills."
1684 );
1685
1686 my $spellsw = $SPELL_PAGE = new CFPlus::UI::ScrolledWindow (expand => 1, scroll_y => 1);
1687 $spellsw->add ($SPELL_LIST = new CFPlus::UI::SpellList);
1688 $ntb->add_tab (
1689 "Spellbook (F4)" => $spellsw,
1690 "Displays all spells you have and lets you edit keyboard shortcuts for them."
1691 );
1692 $ntb->add_tab (
1693 "Inventory (F5)" => $INVENTORY_PAGE = inventory_widget,
1694 "Toggles the inventory window, where you can manage your loot (or treasures :). "
1695 . "You can also hit the <b>Tab</b>-key to show/hide the Inventory."
1696 );
1697 $ntb->add_tab (Pickup => autopickup_setup,
1698 "Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them.");
1699
1700 $ntb->add_tab (Media => media_window,
1701 "License, Author and Source info for media sent by the server.");
1702
1703 $ntb->set_current_page ($INVENTORY_PAGE);
1704
1705 $plwin->add ($ntb);
1706 $plwin
1707 }
1708
1709 sub keyboard_setup {
1710 CFPlus::Macro::keyboard_setup
1711 }
1712
1713 sub help_window {
1714 my $win = new CFPlus::UI::Toplevel
1715 x => 'center',
1716 y => 'center',
1717 z => 4,
1718 name => 'doc_browser',
1719 force_w => int $WIDTH * 7/8,
1720 force_h => int $HEIGHT * 7/8,
1721 title => "Help Browser",
1722 has_close_button => 1;
1723
1724 $win->add (my $vbox = new CFPlus::UI::VBox);
1725
1726 $vbox->add (new CFPlus::UI::FancyFrame
1727 label => "Navigation",
1728 child => (my $buttons = new CFPlus::UI::HBox),
1729 );
1730 $vbox->add (my $viewer = new CFPlus::UI::TextScroller
1731 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
1732
1733 my @history;
1734 my @future;
1735 my $curnode;
1736
1737 my $load_node; $load_node = sub {
1738 my ($node, $para) = @_;
1739
1740 $buttons->clear;
1741
1742 $buttons->add (new CFPlus::UI::Button
1743 text => "⇤",
1744 tooltip => "back to the starting page",
1745 on_activate => sub {
1746 unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
1747 unshift @future, @history;
1748 @history = ();
1749 $load_node->(@{shift @future});
1750 },
1751 );
1752
1753 if (@history) {
1754 $buttons->add (new CFPlus::UI::Button
1755 text => "⋘",
1756 tooltip => "back to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $history[-1][0]) . "</i>",
1757 on_activate => sub {
1758 unshift @future, [$curnode, $viewer->current_paragraph] if $curnode;
1759 $load_node->(@{pop @history});
1760 },
1761 );
1762 }
1763
1764 if (@future) {
1765 $buttons->add (new CFPlus::UI::Button
1766 text => "⋙",
1767 tooltip => "forward to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $future[0][0]) . "</i>",
1768 on_activate => sub {
1769 push @history, [$curnode, $viewer->current_paragraph];
1770 $load_node->(@{shift @future});
1771 },
1772 );
1773 }
1774
1775 $buttons->add (new CFPlus::UI::Label text => " ");
1776
1777 my @path = CFPlus::Pod::full_path_of $node;
1778 pop @path; # drop current node
1779
1780 for my $node (@path) {
1781 $buttons->add (new CFPlus::UI::Button
1782 text => $node->{kw}[0],
1783 tooltip => "go to <i>" . (CFPlus::asxml CFPlus::Pod::full_path $node) . "</i>",
1784 on_activate => sub {
1785 push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
1786 $load_node->($node);
1787 },
1788 );
1789 $buttons->add (new CFPlus::UI::Label text => "/");
1790 }
1791
1792 $buttons->add (new CFPlus::UI::Label text => $node->{kw}[0], padding_x => 4, padding_y => 4);
1793
1794 $curnode = $node;
1795
1796 $viewer->clear;
1797 $viewer->add_paragraph (CFPlus::Pod::as_paragraphs CFPlus::Pod::section_of $curnode);
1798 $viewer->scroll_to ($para);
1799 };
1800
1801 $load_node->(CFPlus::Pod::find pod => "mainpage");
1802
1803 $CFPlus::Pod::goto_document = sub {
1804 my (@path) = @_;
1805
1806 push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = ();
1807
1808 $load_node->((CFPlus::Pod::find @path)[0]);
1809 $win->show;
1810 };
1811
1812 $win
1813 }
1814
1815 sub open_string_query {
1816 my ($title, $cb, $txt, $tooltip) = @_;
1817 my $dialog = new CFPlus::UI::Toplevel
1818 x => "center",
1819 y => "center",
1820 z => 50,
1821 force_w => $WIDTH * 4/5,
1822 title => $title;
1823
1824 $dialog->add (
1825 my $e = new CFPlus::UI::Entry
1826 on_activate => sub { $cb->(@_); $dialog->hide; 0 },
1827 on_key_down => sub { $_[1]->{sym} == 27 and $dialog->hide; 0 },
1828 tooltip => $tooltip
1829 );
1830
1831 $e->grab_focus;
1832 $e->set_text ($txt) if $txt;
1833 $dialog->show;
1834 }
1835
1836 sub open_quit_dialog {
1837 unless ($QUIT_DIALOG) {
1838 $QUIT_DIALOG = new CFPlus::UI::Toplevel
1839 x => "center",
1840 y => "center",
1841 z => 50,
1842 title => "Really Quit?",
1843 on_key_down => sub {
1844 my ($dialog, $ev) = @_;
1845 $ev->{sym} == 27 and $dialog->hide;
1846 }
1847 ;
1848
1849 $QUIT_DIALOG->add (my $vb = new CFPlus::UI::VBox expand => 1);
1850
1851 $vb->add (new CFPlus::UI::Label
1852 text => "You should find a savebed and apply it first!",
1853 max_w => $WIDTH * 0.25,
1854 ellipsize => 0,
1855 );
1856 $vb->add (my $hb = new CFPlus::UI::HBox expand => 1);
1857 $hb->add (new CFPlus::UI::Button
1858 text => "Ok",
1859 expand => 1,
1860 on_activate => sub { $QUIT_DIALOG->hide; 0 },
1861 );
1862 $hb->add (new CFPlus::UI::Button
1863 text => "Quit anyway",
1864 expand => 1,
1865 on_activate => sub { exit },
1866 );
1867 }
1868
1869 $QUIT_DIALOG->show;
1870 $QUIT_DIALOG->grab_focus;
1871 }
1872
1873 sub show_tip_of_the_day {
1874 # find all tips
1875 my @tod = CFPlus::Pod::find tip_of_the_day => "*";
1876
1877 CFPlus::DB::get state => "tip_of_the_day", sub {
1878 my ($todindex) = @_;
1879 $todindex = 0 if $todindex >= @tod;
1880 CFPlus::DB::put state => tip_of_the_day => $todindex + 1, sub { };
1881
1882 # create dialog
1883 my $dialog;
1884
1885 my $close = sub {
1886 $dialog->destroy;
1887 };
1888
1889 $dialog = new CFPlus::UI::Toplevel
1890 x => "center",
1891 y => "center",
1892 z => 3,
1893 name => 'tip_of_the_day',
1894 force_w => int $WIDTH * 4/9,
1895 force_h => int $WIDTH * 2/9,
1896 title => "Tip of the day #" . (1 + $todindex),
1897 child => my $vbox = new CFPlus::UI::VBox,
1898 has_close_button => 1,
1899 on_delete => $close,
1900 ;
1901
1902 $vbox->add (my $viewer = new CFPlus::UI::TextScroller
1903 expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4);
1904 $viewer->add_paragraph (CFPlus::Pod::as_paragraphs CFPlus::Pod::section_of $tod[$todindex]);
1905
1906 $vbox->add (my $table = new CFPlus::UI::Table col_expand => [0, 1]);
1907
1908 $table->add_at (0, 0, new CFPlus::UI::Button
1909 text => "Close",
1910 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>.",
1911 on_activate => $close,
1912 );
1913
1914 $table->add_at (2, 0, new CFPlus::UI::Button
1915 text => "Next",
1916 tooltip => "Show the next <b>Tip of the day</b>.",
1917 on_activate => sub {
1918 $close->();
1919 &show_tip_of_the_day;
1920 },
1921 );
1922
1923 $dialog->show;
1924 };
1925 }
1926
1927 sub sdl_init {
1928 CFPlus::SDL_Init
1929 and die "SDL::Init failed!\n";
1930 }
1931
1932 sub video_init {
1933 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES;
1934
1935 my ($old_w, $old_h) = ($WIDTH, $HEIGHT);
1936
1937 ($WIDTH, $HEIGHT, my ($rgb, $alpha)) = @{ $SDL_MODES[$CFG->{sdl_mode}] };
1938 $FULLSCREEN = $CFG->{fullscreen};
1939 $FAST = $CFG->{fast};
1940
1941 CFPlus::SDL_SetVideoMode $WIDTH, $HEIGHT, $rgb, $alpha, $FULLSCREEN
1942 or die "SDL_SetVideoMode failed: " . (CFPlus::SDL_GetError) . "\n";
1943
1944 $SDL_ACTIVE = 1;
1945 $LAST_REFRESH = time - 0.01;
1946
1947 CFPlus::OpenGL::init;
1948
1949 $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
1950
1951 $CFPlus::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d#
1952
1953 #############################################################################
1954
1955 if ($DEBUG_STATUS) {
1956 CFPlus::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h;
1957 } else {
1958 # create the widgets
1959
1960 $DEBUG_STATUS = new CFPlus::UI::Label
1961 padding => 0,
1962 z => 100,
1963 force_x => "max",
1964 force_y => 0;
1965 $DEBUG_STATUS->show;
1966
1967 $STATUSBOX = new CFPlus::UI::Statusbox;
1968 $STATUSBOX->add ("Use <b>Alt-Enter</b> to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);
1969
1970 (new CFPlus::UI::Frame
1971 bg => [0, 0, 0, 0.4],
1972 force_x => 0,
1973 force_y => "max",
1974 child => $STATUSBOX,
1975 )->show;
1976
1977 CFPlus::UI::Toplevel->new (
1978 title => "Map",
1979 name => "mapmap",
1980 x => 0,
1981 y => $FONTSIZE + 8,
1982 border_bg => [1, 1, 1, 192/255],
1983 bg => [1, 1, 1, 0],
1984 child => ($MAPMAP = new CFPlus::MapWidget::MapMap
1985 tooltip => "<b>Map</b>. On servers that support this feature, this will display an overview of the surrounding areas.",
1986 ),
1987 )->show;
1988
1989 $MAPWIDGET = new CFPlus::MapWidget;
1990 $MAPWIDGET->connect (activate_console => sub {
1991 my ($mapwidget, $preset) = @_;
1992
1993 $MESSAGE_WINDOW->activate_console ($preset)
1994 if $MESSAGE_WINDOW;
1995 });
1996 $MAPWIDGET->show;
1997 $MAPWIDGET->grab_focus;
1998
1999 $SETUP_DIALOG = new CFPlus::UI::Toplevel
2000 title => "Setup",
2001 name => "setup_dialog",
2002 x => 'center',
2003 y => 'center',
2004 z => 2,
2005 force_w => $::WIDTH * 0.6,
2006 force_h => $::HEIGHT * 0.6,
2007 has_close_button => 1,
2008 ;
2009
2010 $METASERVER = metaserver_dialog;
2011 $MESSAGE_WINDOW = new CFPlus::UI::MessageWindow;
2012
2013 $SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFPlus::UI::Notebook expand => 1, debug => 1,
2014 filter => new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1);
2015
2016 $SETUP_NOTEBOOK->add_tab (Server => $SETUP_SERVER = server_setup,
2017 "Configure the server to play on, your username, password and other server-related options.");
2018 $SETUP_NOTEBOOK->add_tab (Client => client_setup,
2019 "Configure various client-specific settings.");
2020 $SETUP_NOTEBOOK->add_tab (Graphics => graphics_setup,
2021 "Configure the video mode, performance, fonts and other graphical aspects of the game.");
2022 $SETUP_NOTEBOOK->add_tab (Audio => audio_setup,
2023 "Configure the use of audio, sound effects and background music.");
2024 $SETUP_NOTEBOOK->add_tab (Keyboard => $SETUP_KEYBOARD = keyboard_setup,
2025 "Lets you define, edit and delete key bindings."
2026 . "There is a shortcut for making bindings: <b>Control-Insert</b> opens the binding editor "
2027 . "with nothing set and the recording started. After doing the actions you "
2028 . "want to record press <b>Insert</b> and you will be asked to press a key-combo. "
2029 . "After pressing the combo the binding will be saved automatically and the "
2030 . "binding editor closes");
2031 $SETUP_NOTEBOOK->add_tab (Debug => debug_setup,
2032 "Some debuggin' options. Do not ask.");
2033
2034 $BUTTONBAR = new CFPlus::UI::Buttonbar x => 0, y => 0, z => 200; # put on top
2035
2036 $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Setup", other => $SETUP_DIALOG,
2037 tooltip => "Toggles a dialog where you can configure all aspects of this client.");
2038
2039 $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW,
2040 tooltip => "Toggles the server message log, where the client collects <i>all</i> messages from the server.");
2041
2042 make_gauge_window->show; # XXX: this has to be set before make_stats_window as make_stats_window calls update_stats_window which updated the gauges also X-D
2043
2044 $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Playerbook", other => player_window,
2045 tooltip => "Toggles the player view, where you can manage Inventory, Spells, Skills and see your Stats.");
2046
2047 $BUTTONBAR->add (new CFPlus::UI::Button
2048 text => "Save Config",
2049 tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
2050 on_activate => sub {
2051 $::CFG->{layout} = CFPlus::UI::get_layout;
2052 CFPlus::write_cfg "$Crossfire::VARDIR/cfplusrc";
2053 status "Configuration Saved";
2054 0
2055 },
2056 );
2057
2058 $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Help!", other => $HELP_WINDOW = help_window,
2059 tooltip => "View Documentation");
2060
2061
2062 $BUTTONBAR->add (new CFPlus::UI::Button
2063 text => "Quit",
2064 tooltip => "Terminates the program",
2065 on_activate => sub {
2066 if ($CONN) {
2067 open_quit_dialog;
2068 } else {
2069 exit;
2070 }
2071 0
2072 },
2073 );
2074
2075 $BUTTONBAR->show;
2076 $SETUP_DIALOG->show;
2077 }
2078
2079 $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
2080 }
2081
2082 sub video_shutdown {
2083 CFPlus::OpenGL::shutdown;
2084
2085 undef $SDL_ACTIVE;
2086 }
2087
2088 my %animate_object;
2089 my $animate_timer;
2090
2091 my $fps = 9;
2092
2093 sub force_refresh {
2094 $fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
2095 debug sprintf "%3.2f", $fps if $ENV{CFPLUS_DEBUG} & 4;
2096
2097 $CFPlus::UI::ROOT->draw;
2098
2099 $WANT_REFRESH = 0;
2100 $CAN_REFRESH = 0;
2101 $LAST_REFRESH = $NOW;
2102
2103 CFPlus::SDL_GL_SwapBuffers;
2104 }
2105
2106 my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub {
2107 $NOW = time;
2108
2109 ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
2110 for CFPlus::poll_events;
2111
2112 if (%animate_object) {
2113 $_->animate ($LAST_REFRESH - $NOW) for values %animate_object;
2114 ++$WANT_REFRESH;
2115 }
2116
2117 if ($WANT_REFRESH) {
2118 force_refresh;
2119 } else {
2120 $CAN_REFRESH = 1;
2121 }
2122 });
2123
2124 sub animation_start {
2125 my ($widget) = @_;
2126 $animate_object{$widget} = $widget;
2127 }
2128
2129 sub animation_stop {
2130 my ($widget) = @_;
2131 delete $animate_object{$widget};
2132 }
2133
2134 %SDL_CB = (
2135 CFPlus::SDL_QUIT => sub {
2136 exit;
2137 },
2138 CFPlus::SDL_VIDEORESIZE => sub {
2139 },
2140 CFPlus::SDL_VIDEOEXPOSE => sub {
2141 CFPlus::UI::full_refresh;
2142 },
2143 CFPlus::SDL_ACTIVEEVENT => sub {
2144 # not useful, as APPACTIVE include sonly iconified state, not unmapped
2145 # printf "active %x %x %x\n", $_[0]{gain}, $_[0]{state}, CFPlus::SDL_GetAppState;#d#
2146 # printf "a %x\n", CFPlus::SDL_GetAppState & CFPlus::SDL_APPACTIVE;#d#
2147 # printf "A\n" if $_[0]{state} & CFPlus::SDL_APPACTIVE;
2148 # printf "K\n" if $_[0]{state} & CFPlus::SDL_APPINPUTFOCUS;
2149 # printf "M\n" if $_[0]{state} & CFPlus::SDL_APPMOUSEFOCUS;
2150 },
2151 CFPlus::SDL_KEYDOWN => sub {
2152 if ($_[0]{mod} & CFPlus::KMOD_ALT && $_[0]{sym} == 13) {
2153 # alt-enter
2154 $FULLSCREEN_ENABLE->toggle;
2155 video_shutdown;
2156 video_init;
2157 } else {
2158 CFPlus::UI::feed_sdl_key_down_event ($_[0]);
2159 }
2160 },
2161 CFPlus::SDL_KEYUP => \&CFPlus::UI::feed_sdl_key_up_event,
2162 CFPlus::SDL_MOUSEMOTION => \&CFPlus::UI::feed_sdl_motion_event,
2163 CFPlus::SDL_MOUSEBUTTONDOWN => \&CFPlus::UI::feed_sdl_button_down_event,
2164 CFPlus::SDL_MOUSEBUTTONUP => \&CFPlus::UI::feed_sdl_button_up_event,
2165 CFPlus::SDL_USEREVENT => sub {
2166 if ($_[0]{code} == 1) {
2167 audio_channel_finished $_[0]{data1};
2168 } elsif ($_[0]{code} == 0) {
2169 audio_music_finished;
2170 }
2171 },
2172 );
2173
2174 #############################################################################
2175
2176 $SIG{INT} = $SIG{TERM} = sub { exit };
2177
2178 {
2179 CFPlus::read_cfg "$Crossfire::VARDIR/cfplusrc";
2180 CFPlus::DB::Server::run;
2181
2182 CFPlus::UI::set_layout ($::CFG->{layout});
2183
2184 my %DEF_CFG = (
2185 sdl_mode => 0,
2186 fullscreen => 0,
2187 fast => 0,
2188 map_scale => 1,
2189 fow_enable => 1,
2190 fow_intensity => 0,
2191 map_smoothing => 1,
2192 gui_fontsize => 1,
2193 log_fontsize => 0.7,
2194 gauge_fontsize => 1,
2195 gauge_size => 0.35,
2196 stat_fontsize => 0.7,
2197 mapsize => 100,
2198 audio_enable => 1,
2199 effects_enable => 1,
2200 effects_volume => 1,
2201 bgm_enable => 1,
2202 bgm_volume => 0.5,
2203 output_sync => 1,
2204 output_count => 1,
2205 output_rate => "",
2206 pickup => 0,
2207 inv_sort => "mtime",
2208 default => "profile", # default profile
2209 show_tips => 1,
2210 logview_max_par => 1000,
2211 );
2212
2213 while (my ($k, $v) = each %DEF_CFG) {
2214 $CFG->{$k} = $v unless exists $CFG->{$k};
2215 }
2216
2217 $CFG->{profile}{default}{host} ||= "crossfire.schmorp.de";
2218 $PROFILE = $CFG->{profile}{default};
2219
2220 # convert old bindings (only default profile matters)
2221 if (my $bindings = delete $PROFILE->{bindings}) {
2222 while (my ($mod, $syms) = each %$bindings) {
2223 while (my ($sym, $cmds) = each %$syms) {
2224 push @{ $PROFILE->{macro} }, {
2225 accelkey => [$mod*1, $sym*1],
2226 action => $cmds,
2227 };
2228 }
2229 }
2230 }
2231
2232 sdl_init;
2233
2234 @SDL_MODES = CFPlus::SDL_ListModes 8, 8;
2235 @SDL_MODES = CFPlus::SDL_ListModes 5, 0 unless @SDL_MODES;
2236 @SDL_MODES or CFPlus::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)";
2237
2238 @SDL_MODES = sort { $a->[0] * $a->[1] <=> $b->[0] * $b->[1] } @SDL_MODES;
2239
2240 $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES;
2241
2242 {
2243 my @fonts = map CFPlus::find_rcfile "fonts/$_", qw(
2244 DejaVuSans.ttf
2245 DejaVuSansMono.ttf
2246 DejaVuSans-Bold.ttf
2247 DejaVuSansMono-Bold.ttf
2248 DejaVuSans-Oblique.ttf
2249 DejaVuSansMono-Oblique.ttf
2250 DejaVuSans-BoldOblique.ttf
2251 DejaVuSansMono-BoldOblique.ttf
2252 );
2253
2254 CFPlus::add_font $_ for @fonts;
2255
2256 CFPlus::pango_init;
2257
2258 $FONT_PROP = new_from_file CFPlus::Font $fonts[0];
2259 $FONT_FIXED = new_from_file CFPlus::Font $fonts[1];
2260
2261 $FONT_PROP->make_default;
2262 }
2263
2264 # compare mono (ft) vs. rgba (cairo)
2265 # ft - 1.8s, cairo 3s, even in alpha-only mode
2266 # for my $rgba (0..1) {
2267 # my $t1 = Time::HiRes::time;
2268 # for (1..1000) {
2269 # my $layout = CFPlus::Layout->new ($rgba);
2270 # $layout->set_text ("hallo" x 100);
2271 # $layout->render;
2272 # }
2273 # my $t2 = Time::HiRes::time;
2274 # warn $t2-$t1;
2275 # }
2276
2277 $startup_done->();
2278
2279 video_init;
2280 audio_init;
2281 }
2282
2283 show_tip_of_the_day if $CFG->{show_tips};
2284
2285 Event::loop;
2286 #CFPlus::SDL_Quit;
2287 #CFPlus::_exit 0;
2288
2289 END {
2290 CFPlus::SDL_Quit;
2291 CFPlus::DB::Server::stop;
2292 }
2293
2294 =head1 NAME
2295
2296 cfplus - A Crossfire+ and Crossfire game client
2297
2298 =head1 SYNOPSIS
2299
2300 Just run it - no commandline arguments are supported.
2301
2302 =head1 USAGE
2303
2304 cfplus utilises OpenGL for all UI elements and the game. It is supposed to be used
2305 fullscreen and interactively.
2306
2307 =head1 DEBUGGING
2308
2309
2310 CFPLUS_DEBUG - environment variable
2311
2312 1 draw borders around widgets
2313 2 add low-level widget info to tooltips
2314 4 show fps
2315 8 suppress tooltips
2316
2317 =head1 AUTHOR
2318
2319 Marc Lehmann <crossfire@schmorp.de>, Robin Redeker <elmex@ta-sa.org>
2320
2321
2322