ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/bin/cfplus
Revision: 1.207
Committed: Thu Aug 9 11:02:08 2007 UTC (16 years, 9 months ago) by root
Branch: MAIN
Changes since 1.206: +1 -7 lines
Log Message:
implement set_positon_r and use it

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