#!/opt/bin/perl my $startup_done = sub { }; our $PANGO = "1.5.0"; # do splash-screen thingy on win32 BEGIN { if (%PAR::LibCache && $^O eq "MSWin32") { while (my ($filename, $zip) = each %PAR::LibCache) { $zip->extractMember ("SPLASH.bmp", "$ENV{PAR_TEMP}/SPLASH.bmp"); } require Win32::GUI::SplashScreen; Win32::GUI::SplashScreen::Show ( -file => "$ENV{PAR_TEMP}/SPLASH.bmp", ); $startup_done = sub { Win32::GUI::SplashScreen::Done (1); }; } } use strict; use utf8; use Carp 'verbose'; # do things only needed for single-binary version (par) BEGIN { if (%PAR::LibCache) { @INC = grep ref, @INC; # weed out all paths except pars loader refs my $tmp = $ENV{PAR_TEMP}; while (my ($filename, $zip) = each %PAR::LibCache) { for ($zip->memberNames) { next unless /^root\/(.*)/; $zip->extractMember ($_, "$tmp/$1") unless -e "$tmp/$1"; } } if ($^O eq "MSWin32") { # relocatable } else { # unix, need to patch pango rc file open my $fh, "<:perlio", "$tmp/usr/lib/pango/$PANGO/module-files.d/libpango1.0-0.modules" or die "$tmp/usr/lib/$PANGO/module-files.d/libpango1.0-0.modules: $!"; local $/; my $rc = <$fh>; $rc =~ s/^\//$tmp\//gm; # replace abs paths by relative ones mkdir "$tmp/pango-modules"; open my $fh, ">:perlio", "$tmp/pango-modules/pango.modules" or die "$tmp/pango-modules/pango.modules: $!"; print $fh $rc; $ENV{PANGO_RC_FILE} = "$tmp/pango.rc"; open my $fh, ">:perlio", $ENV{PANGO_RC_FILE} or die "$ENV{PANGO_RC_FILE}: $!"; print $fh "[Pango]\nModuleFiles = $tmp/pango-modules\n"; } unshift @INC, $tmp; } } # need to do it again because that pile of garbage called PAR nukes it before main unshift @INC, $ENV{PAR_TEMP} if %PAR::LibCache; use Time::HiRes 'time'; use Event; use Crossfire; use Crossfire::Protocol::Constants; use Compress::LZF; use CFPlus; use CFPlus::OpenGL (); use CFPlus::Protocol; use CFPlus::DB; use CFPlus::UI; use CFPlus::UI::Canvas; use CFPlus::UI::Inventory; use CFPlus::UI::SpellList; use CFPlus::UI::MessageWindow; use CFPlus::Pod; use CFPlus::MapWidget; use CFPlus::Macro; $SIG{QUIT} = sub { Carp::cluck "QUIT" }; $SIG{PIPE} = 'IGNORE'; $Event::Eval = 1; $Event::DIED = sub { CFPlus::fatal Carp::longmess $_[1] }; my $MAX_FPS = 60; my $MIN_FPS = 5; # unused as of yet our $META_SERVER = "http://metaserver.schmorp.de/current.json"; our $LAST_REFRESH; our $NOW; our $CFG; our $CONN; our $PROFILE; # current profile our $FAST; # fast, low-quality mode, possibly useful for software-rendering our $WANT_REFRESH; our $CAN_REFRESH; our @SDL_MODES; our $WIDTH; our $HEIGHT; our $FULLSCREEN; our $FONTSIZE; our $FONT_PROP; our $FONT_FIXED; our $MAP; our $MAPMAP; our $MAPWIDGET; our $BUTTONBAR; our $METASERVER; our $LOGIN_BUTTON; our $QUIT_DIALOG; our $HOST_ENTRY; our $FULLSCREEN_ENABLE; our $PICKUP_ENABLE; our $SERVER_INFO; our $SETUP_DIALOG; our $SETUP_NOTEBOOK; our $SETUP_SERVER; our $SETUP_KEYBOARD; our $PL_NOTEBOOK; our $PL_WINDOW; our $INVENTORY_PAGE; our $STATS_PAGE; our $SKILL_PAGE; our $SPELL_PAGE; our $SPELL_LIST; our $HELP_WINDOW; our $MESSAGE_WINDOW; our $FLOORBOX; our $GAUGES; our $STATWIDS; our $SDL_ACTIVE; our %SDL_CB; our $SDL_MIXER; our $MUSIC_DEFAULT = "in_a_heartbeat.ogg"; our @MUSIC_WANT; our $MUSIC_START; our $MUSIC_PLAYING; our $MUSIC_PLAYER; our $MUSIC_RESUME = 30; # resume music when players less than these many seconds before our @SOUNDS; # event => file mapping our %AUDIO_CHUNKS; # audio files our $ALT_ENTER_MESSAGE; our $STATUSBOX; our $DEBUG_STATUS; our $INV; our $INVR; our $INV_RIGHT_HB; our $PICKUP_CFG; sub status { $STATUSBOX->add (CFPlus::asxml $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]); } sub debug { $DEBUG_STATUS->set_text ($_[0]); } sub message { my ($para) = @_; $MESSAGE_WINDOW->message ($para); } sub destroy_query_dialog { (delete $_[0]{query_dialog})->destroy if $_[0]{query_dialog}; } # FIXME: a very ugly hack to wait for stat update look below! #d# our $QUERY_TIMER; #d# # server query dialog sub server_query { my ($conn, $flags, $prompt) = @_; # FIXME: a very ugly hack to wait for stat update #d# if ($prompt =~ /roll new stats/ and not $conn->{stat_change_with}) { unless ($QUERY_TIMER) { $QUERY_TIMER = Event->timer ( after => 1, cb => sub { server_query ($conn, $flags, $prompt, 1); $QUERY_TIMER = undef } ); return; } } $conn->{query_dialog} = my $dialog = new CFPlus::UI::Toplevel x => "center", y => "center", title => "Server Query", child => my $vbox = new CFPlus::UI::VBox, ; my @dialog = my $label = new CFPlus::UI::Label max_w => $::WIDTH * 0.8, ellipsise => 0, text => $prompt; if ($flags & CS_QUERY_YESNO) { push @dialog, my $hbox = new CFPlus::UI::HBox; $hbox->add (new CFPlus::UI::Button text => "No", on_activate => sub { $conn->send ("reply n"); $dialog->destroy; 0 } ); $hbox->add (new CFPlus::UI::Button text => "Yes", on_activate => sub { $conn->send ("reply y"); destroy_query_dialog $conn; 0 }, ); $dialog->grab_focus; } elsif ($flags & CS_QUERY_SINGLECHAR) { if ($prompt =~ /Now choose a character|Press any key for the next race/i) { $dialog->{tooltip} = "#charcreation_focus"; unshift @dialog, new CFPlus::UI::Label max_w => $::WIDTH * 0.8, ellipsise => 0, markup => "\nOr use your keyboard and the text entry below:\n"; unshift @dialog, my $table = new CFPlus::UI::Table; $table->add_at (0, 0, new CFPlus::UI::Button text => "Next Race", on_activate => sub { $conn->send ("reply n"); destroy_query_dialog $conn; 0 }, ); $table->add_at (2, 0, new CFPlus::UI::Button text => "Accept", on_activate => sub { $conn->send ("reply d"); destroy_query_dialog $conn; 0 }, ); if ($conn->{chargen_race_description}) { unshift @dialog, new CFPlus::UI::Label max_w => $::WIDTH * 0.8, ellipsise => 0, markup => "$conn->{chargen_race_description}", ; } unshift @dialog, new CFPlus::UI::Face face => $conn->{player}{face}, bg => [.2, .2, .2, 1], min_w => 64, min_h => 64, ; if ($conn->{chargen_race_title}) { unshift @dialog, new CFPlus::UI::Label allign => 1, ellipsise => 0, markup => "Race: $conn->{chargen_race_title}", ; } unshift @dialog, new CFPlus::UI::Label max_w => $::WIDTH * 0.4, ellipsise => 0, markup => (CFPlus::Pod::section_label ui => "chargen_race"), ; } elsif ($prompt =~ /roll new stats/) { if (my $stat = delete $conn->{stat_change_with}) { $conn->send ("reply $stat"); destroy_query_dialog $conn; return; } unshift @dialog, new CFPlus::UI::Label max_w => $::WIDTH * 0.4, ellipsise => 0, markup => "\nOr use your keyboard and the text entry below:\n"; unshift @dialog, my $table = new CFPlus::UI::Table; # left: re-roll $table->add_at (0, 0, new CFPlus::UI::Button text => "Roll Again", on_activate => sub { $conn->send ("reply y"); destroy_query_dialog $conn; 0 }, ); # center: swap stats my ($sw1, $sw2) = map +(new CFPlus::UI::Selector expand => 1, value => $_, options => [ [1 => "Str", "Strength ($conn->{stat}{+CS_STAT_STR})"], [2 => "Dex", "Dexterity ($conn->{stat}{+CS_STAT_DEX})"], [3 => "Con", "Constitution ($conn->{stat}{+CS_STAT_CON})"], [4 => "Int", "Intelligence ($conn->{stat}{+CS_STAT_INT})"], [5 => "Wis", "Wisdom ($conn->{stat}{+CS_STAT_WIS})"], [6 => "Pow", "Power ($conn->{stat}{+CS_STAT_POW})"], [7 => "Cha", "Charisma ($conn->{stat}{+CS_STAT_CHA})"], ], ), 1 .. 2; $table->add_at (2, 0, new CFPlus::UI::Button text => "Swap Stats", on_activate => sub { $conn->{stat_change_with} = $sw2->{value}; $conn->send ("reply $sw1->{value}"); destroy_query_dialog $conn; 0 }, ); $table->add_at (2, 1, new CFPlus::UI::HBox children => [$sw1, $sw2]); # right: accept $table->add_at (4, 0, new CFPlus::UI::Button text => "Accept", on_activate => sub { $conn->send ("reply n"); $STATS_PAGE->hide; destroy_query_dialog $conn; 0 }, ); unshift @dialog, my $hbox = new CFPlus::UI::HBox; for ( [Str => CS_STAT_STR], [Dex => CS_STAT_DEX], [Con => CS_STAT_CON], [Int => CS_STAT_INT], [Wis => CS_STAT_WIS], [Pow => CS_STAT_POW], [Cha => CS_STAT_CHA], ) { my ($name, $id) = @$_; $hbox->add (new CFPlus::UI::Label markup => "$conn->{stat}{$id} $name", align => 0, expand => 1, can_events => 1, can_hover => 1, tooltip => "#stat_$name", ); } unshift @dialog, new CFPlus::UI::Label max_w => $::WIDTH * 0.4, ellipsise => 0, markup => (CFPlus::Pod::section_label ui => "chargen_stats"), ; } push @dialog, my $entry = new CFPlus::UI::Entry on_changed => sub { $conn->send ("reply $_[1]"); destroy_query_dialog $conn; 0 }, ; $entry->grab_focus; } else { $dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)"; push @dialog, my $entry = new CFPlus::UI::Entry $flags & CS_QUERY_HIDEINPUT ? (hidden => "*") : (), on_activate => sub { $conn->send ("reply $_[1]"); destroy_query_dialog $conn; 0 }, ; $entry->grab_focus; } $vbox->add (@dialog); $dialog->show; } sub start_game { status "logging in..."; $LOGIN_BUTTON->set_text ("Logout"); $SETUP_DIALOG->hide; my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32; my ($host, $port) = split /:/, $PROFILE->{host}; $MAP = new CFPlus::Map; $CONN = eval { new CFPlus::Protocol host => $host, port => $port || 13327, user => $PROFILE->{user}, pass => $PROFILE->{password}, mapw => $mapsize, maph => $mapsize, client => "cfplus $CFPlus::VERSION $] $^O", map_widget => $MAPWIDGET, statusbox => $STATUSBOX, map => $MAP, mapmap => $MAPMAP, query => \&server_query, setup_req => { smoothing => $CFG->{map_smoothing}*1, }, sound_play => sub { my ($x, $y, $soundnum, $type) = @_; $SDL_MIXER or return; my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]} or return; $chunk->play; }, }; if ($CONN) { CFPlus::lowdelay fileno $CONN->{fh}; status "login successful"; } else { status "unable to connect"; stop_game(); } } sub stop_game { $LOGIN_BUTTON->set_text ("Login"); $SETUP_NOTEBOOK->set_current_page ($SETUP_SERVER); $SETUP_DIALOG->show; $PL_WINDOW->hide; $SPELL_LIST->clear_spells; $CFPlus::UI::ROOT->emit (stop_game => ! ! $CONN); &audio_music_set ([]); return unless $CONN; status "connection closed"; destroy_query_dialog $CONN; $CONN->destroy; $CONN = 0; # false, does not autovivify undef $MAP; } sub graphics_setup { my $vbox = new CFPlus::UI::VBox; $vbox->add (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]); my $row = 0; $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "OpenGL Info"); $table->add_at (1, $row++, new CFPlus::UI::Label valign => 0, fontsize => 0.8, text => CFPlus::OpenGL::gl_vendor . ", " . CFPlus::OpenGL::gl_version, can_events => 1, tooltip => "" . (CFPlus::OpenGL::gl_extensions) . ""); my $vidmode_tooltip = "Video Mode. The video mode to use for fullscreen (and the window size for windowed operation). " . "The format is width x height \@ depth-per-channel + alpha-channel."; $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Video Mode"); $table->add_at (1, $row++, my $hbox = new CFPlus::UI::HBox); $hbox->add (my $mode_slider = new CFPlus::UI::Slider force_w => $WIDTH * 0.1, expand => 1, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1], tooltip => $vidmode_tooltip); $hbox->add (my $mode_label = new CFPlus::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999@9+9", can_events => 1, tooltip => $vidmode_tooltip); $mode_slider->connect (changed => sub { my ($self, $value) = @_; $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value; $mode_label->set_text (sprintf '%dx%d@%d+%d', @{$SDL_MODES[$value]}); }); $mode_slider->emit (changed => $mode_slider->{range}[0]); $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fullscreen"); $table->add_at (1, $row++, $FULLSCREEN_ENABLE = new CFPlus::UI::CheckBox state => $CFG->{fullscreen}, tooltip => "Bring the client into fullscreen mode.", on_changed => sub { my ($self, $value) = @_; $CFG->{fullscreen} = $value; 0 } ); $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fast & Ugly"); $table->add_at (1, $row++, new CFPlus::UI::CheckBox state => $CFG->{fast}, tooltip => "Lower the visual quality considerably to speed up rendering.", on_changed => sub { my ($self, $value) = @_; $CFG->{fast} = $value; 0 } ); $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "GUI Fontsize"); $table->add_at (1, $row++, new CFPlus::UI::Slider range => [$CFG->{gui_fontsize}, 0.5, 2, 0, 0.1], tooltip => "The base font size used by most GUI elements that do not have their own setting.", on_changed => sub { $CFG->{gui_fontsize} = $_[1]; 0 }, ); $table->add_at (1, $row++, new CFPlus::UI::Button expand => 1, align => 0, text => "Apply", tooltip => "Apply the video settings above.", on_activate => sub { video_shutdown (); video_init (); 0 } ); $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Scale"); $table->add_at (1, $row++, new CFPlus::UI::Slider range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1], tooltip => "Enlarge or shrink the displayed map. Changes are instant.", on_changed => sub { my ($self, $value) = @_; $CFG->{map_scale} = 2 ** $value; 0 } ); $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Smoothing"); $table->add_at (1, $row++, new CFPlus::UI::CheckBox state => $CFG->{map_smoothing}, tooltip => "Map Smoothing tries to make tile borders less square. " . "This increases load on the graphics subsystem and works only with 2.x servers. " . "Changes take effect at next connection only.", on_changed => sub { my ($self, $value) = @_; $CFG->{map_smoothing} = $value; 0 } ); $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fog of War"); $table->add_at (1, $row++, new CFPlus::UI::CheckBox state => $CFG->{fow_enable}, tooltip => "Fog-of-War marks areas that cannot be seen by the player. Changes are instant.", on_changed => sub { my ($self, $value) = @_; $CFG->{fow_enable} = $value; 0 } ); $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "FoW Intensity"); $table->add_at (1, $row++, new CFPlus::UI::Slider range => [$CFG->{fow_intensity}, 0, 1, 0, 1 / 256], tooltip => "Fog of War Lightness. The higher the intensity, the lighter the Fog-of-War color. Changes are instant.", on_changed => sub { my ($self, $value) = @_; $CFG->{fow_intensity} = $value; 0 } ); $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Message Fontsize"); $table->add_at (1, $row++, new CFPlus::UI::Slider range => [$CFG->{log_fontsize}, 0.5, 2, 0, 0.1], tooltip => "The font size used by the message/server log window only. Changes are instant.", on_changed => sub { $MESSAGE_WINDOW->set_fontsize ($CFG->{log_fontsize} = $_[1]); 0 }, ); $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Gauge fontsize"); $table->add_at (1, $row++, new CFPlus::UI::Slider range => [$CFG->{gauge_fontsize}, 0.5, 2, 0, 0.1], tooltip => "Adjusts the fontsize of the gauges at the bottom right. Changes are instant.", on_changed => sub { $CFG->{gauge_fontsize} = $_[1]; &set_gauge_window_fontsize; 0 } ); $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Gauge size"); $table->add_at (1, $row++, new CFPlus::UI::Slider range => [$CFG->{gauge_size}, 0.2, 0.8], tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.", on_changed => sub { $CFG->{gauge_size} = $_[1]; $GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size}); 0 } ); $vbox } sub audio_setup { my $vbox = new CFPlus::UI::VBox; $vbox->add (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]); my $row = 0; $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Audio Enable"); $table->add_at (1, $row++, new CFPlus::UI::CheckBox state => $CFG->{audio_enable}, tooltip => "Master Audio Enable. If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.", on_changed => sub { $CFG->{audio_enable} = $_[1]; 0 } ); # $table->add_at (0, 9, new CFPlus::UI::Label valign => 0, align => 1, text => "Effects Volume"); # $table->add_at (1, 8, new CFPlus::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], on_changed => sub { # $CFG->{effects_volume} = $_[1]; # }); $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Background Music"); $table->add_at (1, $row++, my $hbox = new CFPlus::UI::HBox); $hbox->add (new CFPlus::UI::CheckBox expand => 1, state => $CFG->{bgm_enable}, tooltip => "If enabled, playing of background music is enabled. If disabled, no background music will be played.", on_changed => sub { $CFG->{bgm_enable} = $_[1]; 0 } ); $hbox->add (new CFPlus::UI::Slider expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128], tooltip => "The volume of the background music. Changes are instant.", on_changed => sub { $CFG->{bgm_volume} = $_[1]; CFPlus::MixMusic::volume $_[1] * 128; 0 } ); $table->add_at (1, $row++, new CFPlus::UI::Button expand => 1, align => 0, text => "Apply", tooltip => "Apply the audio settings", on_activate => sub { audio_shutdown (); audio_init (); 0 } ); $vbox } sub set_gauge_window_fontsize { for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) { $_->set_fontsize ($::CFG->{gauge_fontsize}); } } sub make_gauge_window { my $gh = int $HEIGHT * $CFG->{gauge_size}; my $win = new CFPlus::UI::Frame ( force_x => 0, force_y => "max", force_w => $WIDTH, force_h => $gh, ); $win->add (my $hbox = new CFPlus::UI::HBox children => [ (new CFPlus::UI::HBox expand => 1), (new CFPlus::UI::VBox children => [ (new CFPlus::UI::Empty expand => 1), (new CFPlus::UI::Frame bg => [0, 0, 0, 0.4], child => ($FLOORBOX = new CFPlus::UI::Table)), ]), (my $vbox = new CFPlus::UI::VBox), ], ); $vbox->add (new CFPlus::UI::HBox expand => 1, children => [ (new CFPlus::UI::Empty expand => 1), (my $hb = new CFPlus::UI::HBox), ], ); $hb->add (my $hg = new CFPlus::UI::Gauge type => 'hp', tooltip => "#stat_health"); $hb->add (my $mg = new CFPlus::UI::Gauge type => 'mana', tooltip => "#stat_mana"); $hb->add (my $gg = new CFPlus::UI::Gauge type => 'grace', tooltip => "#stat_grace"); $hb->add (my $fg = new CFPlus::UI::Gauge type => 'food', tooltip => "#stat_food"); $vbox->add (my $exp = new CFPlus::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1, tooltip => "#stat_exp"); $vbox->add (my $rng = new CFPlus::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1, tooltip => "#stat_ranged"); $GAUGES = { exp => $exp, win => $win, range => $rng, food => $fg, mana => $mg, hp => $hg, grace => $gg }; &set_gauge_window_fontsize; $win } sub debug_setup { my $table = new CFPlus::UI::Table; $table->add_at (0, 0, new CFPlus::UI::Label text => "Widget Borders"); $table->add_at (1, 0, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 1; 0 }); $table->add_at (0, 1, new CFPlus::UI::Label text => "Tooltip Widget Info"); $table->add_at (1, 1, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 2; 0 }); $table->add_at (0, 2, new CFPlus::UI::Label text => "Show FPS"); $table->add_at (1, 2, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 4; 0 }); $table->add_at (0, 3, new CFPlus::UI::Label text => "Suppress Tooltips"); $table->add_at (1, 3, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 8; 0 }); $table->add_at (0, 4, new CFPlus::UI::Button text => "die on click(tm)", on_activate => sub { &CFPlus::debug() } ); $table->add_at (0, 5, new CFPlus::UI::TextEdit text => "line1\0152\0153");#d# $table->add_at (7,7, my $t = new CFPlus::UI::Table expand => 0); $t->add_at (0,0, new CFPlus::UI::Label text => "a a a a", rowspan => 1, colspan => 2); $t->add_at (2,0, new CFPlus::UI::Label text => "b\nb", rowspan => 2, colspan => 1); $t->add_at (1,2, new CFPlus::UI::Label text => "c c c c", rowspan => 1, colspan => 2); $t->add_at (0,1, new CFPlus::UI::Label text => "d\nd", rowspan => 2, colspan => 1); $t->add_at (1,1, new CFPlus::UI::Label text => "e"); $table->add_at (7, 6, my $c = new CFPlus::UI::Canvas); $c->add_items ({ type => "line_loop", color => [0, 1, 0], width => 9, coord_mode => "abs", coord => [[10, 5], [5, 50], [20, 5], [5, 60]], }); $c->add_items ({ type => "lines", color => [1, 1, 0], width => 2, coord_mode => "rel", coord => [[0,0], [1,1], [1,0], [0,1]], }); $c->add_items ({ type => "polygon", color => [0, 0.43, 0], width => 2, coord_mode => "rel", coord => [[0,0.2], [1,.4], [1,.6], [0,.8]], }); $table } sub stats_window { my $r = new CFPlus::UI::ScrolledWindow ( expand => 1, scroll_y => 1 ); $r->add (my $vb = new CFPlus::UI::VBox); $vb->add (new CFPlus::UI::FancyFrame label => "Player", child => (my $pi = new CFPlus::UI::VBox), ); $pi->add ($STATWIDS->{title} = new CFPlus::UI::Label valign => 0, align => -1, text => "Title:", expand => 1, can_hover => 1, can_events => 1, tooltip => "Your name and title. You can change your title by using the title command, if supported by the server."); $pi->add ($STATWIDS->{map} = new CFPlus::UI::Label valign => 0, align => -1, text => "Map:", expand => 1, can_hover => 1, can_events => 1, tooltip => "The map you are currently on (if supported by the server)."); $pi->add (my $hb0 = new CFPlus::UI::HBox); $hb0->add ($STATWIDS->{weight} = new CFPlus::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1, can_hover => 1, can_events => 1, tooltip => "The weight of the player including all inventory items."); $hb0->add ($STATWIDS->{m_weight} = new CFPlus::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1, can_hover => 1, can_events => 1, tooltip => "The weight limit: you cannot carry more than this."); $vb->add (new CFPlus::UI::FancyFrame label => "Primary/Secondary Statistics", child => (my $hb = new CFPlus::UI::HBox expand => 1), ); $hb->add (my $tbl = new CFPlus::UI::Table expand => 1); my $color2 = [1, 1, 0]; for ( [0, 0, st_str => "Str", 30], [0, 1, st_dex => "Dex", 30], [0, 2, st_con => "Con", 30], [0, 3, st_int => "Int", 30], [0, 4, st_wis => "Wis", 30], [0, 5, st_pow => "Pow", 30], [0, 6, st_cha => "Cha", 30], [2, 0, st_wc => "Wc", -120], [2, 1, st_ac => "Ac", -120], [2, 2, st_dam => "Dam", 120], [2, 3, st_arm => "Arm", 120], [2, 4, st_spd => "Spd", 10.54], [2, 5, st_wspd => "WSp", 10.54], ) { my ($col, $row, $id, $label, $template) = @$_; $tbl->add_at ($col , $row, $STATWIDS->{$id} = new CFPlus::UI::Label font => $FONT_FIXED, can_hover => 1, can_events => 1, valign => 0, align => +1, template => $template, tooltip => "#stat_$label"); $tbl->add_at ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFPlus::UI::Label font => $FONT_FIXED, can_hover => 1, can_events => 1, fg => $color2, valign => 0, align => -1, text => $label, tooltip => "#stat_$label"); } $vb->add (new CFPlus::UI::FancyFrame label => "Resistancies", child => (my $tbl2 = new CFPlus::UI::Table expand => 1), ); my $row = 0; my $col = 0; my %resist_names = ( slow => ["Slow", "Slow (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.)"], holyw => ["Holy Word", "Holy Word (resistance you against getting the fear when someone whose god doesn't like you spells the holy word on you.)"], conf => ["Confusion", "Confusion (If you are hit by confusion you will move into random directions, and likely into monsters.)"], fire => ["Fire", "Fire (just your resistance to fire spells like burning hands, dragonbreath, meteor swarm fire, ...)"], depl => ["Depletion", "Depletion (some monsters and other effects can cause stats depletion)"], magic => ["Magic", "Magic (resistance to magic spells like magic missile or similar)"], drain => ["Draining", "Draining (some monsters (e.g. vampires) and other effects can steal experience)"], acid => ["Acid", "Acid (resistance to acid, acid hurts pretty much and also corrodes your weapons)"], pois => ["Poison", "Poison (resistance to getting poisoned)"], para => ["Paralysation", "Paralysation (this resistance affects the chance you get paralysed)"], deat => ["Death", "Death (resistance against death spells)"], phys => ["Physical", "Physical (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.)"], blind => ["Blind", "Blind (blind resistance affects the chance of a successful blinding attack)"], fear => ["Fear", "Fear (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)"], tund => ["Turn undead", "Turn undead (affects your resistancy to various forms of 'turn undead' spells. Only relevant when you are, in fact, undead..."], elec => ["Electricity", "Electricity (resistance against electricity, spells like large lightning, small lightning, ...)"], cold => ["Cold", "Cold (this is your resistance against cold spells like icestorm, snowstorm, ...)"], ghit => ["Ghost hit", "Ghost hit (special attack used by ghosts and ghost-like beings)"], ); for (qw/slow holyw conf fire depl magic drain acid pois para deat phys blind fear tund elec cold ghit/) { $tbl2->add_at ($col, $row, $STATWIDS->{"res_$_"} = new CFPlus::UI::Label font => $FONT_FIXED, template => "-100%", align => +1, valign => 0, can_events => 1, can_hover => 1, tooltip => $resist_names{$_}->[1], ); $tbl2->add_at ($col + 1, $row, new CFPlus::UI::Image font => $FONT_FIXED, can_hover => 1, can_events => 1, path => "ui/resist/resist_$_.png", tooltip => $resist_names{$_}->[1], ); $tbl2->add_at ($col + 2, $row, new CFPlus::UI::Label text => $resist_names{$_}->[0], font => $FONT_FIXED, can_hover => 1, can_events => 1, tooltip => $resist_names{$_}->[1], ); $row++; if ($row % 6 == 0) { $col += 3; $row = 0; } } #update_stats_window ({}); $r } sub skill_window { my $sw = new CFPlus::UI::ScrolledWindow (expand => 1); $sw->add ($STATWIDS->{skill_tbl} = new CFPlus::UI::Table expand => 1, col_expand => [0, 0, 1, 0, 0, 1]); $sw } sub formsep($) { scalar reverse join ",", unpack "(A3)*", reverse $_[0] * 1 } my $METASERVER_ATIME; sub update_metaserver { my ($metaserver_dialog) = @_; $METASERVER = $metaserver_dialog if defined $metaserver_dialog; return if $METASERVER_ATIME > time; $METASERVER_ATIME = time + 60; my $table = $METASERVER->{table}; $table->clear; $table->add_at (0, 0, my $label = new CFPlus::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list..."); my $ok = 0; CFPlus::background { my $ua = CFPlus::lwp_useragent; CFPlus::background_msg CFPlus::from_json +(CFPlus::lwp_check $ua->get ($META_SERVER))->decoded_content; } sub { my ($msg) = @_; if ($msg) { $table->clear; my @tip = ( "The current number of users logged in on the server.", "The hostname of the server.", "The time this server has been running without being restarted.", "The server software version - a '+' indicates a Crossfire+ server.", "Short information about this server provided by its admins.", ); my @col = qw(#Users Host Uptime Version Description); $table->add_at ($_, 0, new CFPlus::UI::Label can_hover => 1, can_events => 1, align => 0, fg => [1, 1, 0], text => $col[$_], tooltip => $tip[$_]) for 0 .. $#col; my @align = qw(1 0 1 1 -1); my $y = 0; for my $m (@{ $msg->{servers} }) { my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime, $highlight) = @$m{qw(ip age hostname users version description ibytes obytes uptime highlight)}; for ($desc) { s/
/\n/gi; s/
  • /\n· /gi; s/<.*?>//sgi; s/&/&/g; s/<//g; } $uptime = sprintf "%dd %02d:%02d:%02d", (int $uptime / 86400), (int $uptime / 3600) % 24, (int $uptime / 60) % 60, $uptime % 60; $m = [$users, $host, $uptime, $version, $desc]; $y++; $table->add_at (scalar @$m, $y, new CFPlus::UI::VBox children => [ (new CFPlus::UI::Button text => "Use", tooltip => "Put this server into the Host:Port field", on_activate => sub { $HOST_ENTRY->set_text ($CFG->{profile}{default}{host} = $host); $METASERVER->hide; 0 }, ), (new CFPlus::UI::Empty expand => 1), ]); $table->add_at ($_, $y, new CFPlus::UI::Label max_w => $::WIDTH * 0.4, ellipsise => 0, align => $align[$_], text => $m->[$_], tooltip => $tip[$_], fg => ($highlight ? [1, 1, 1] : [.7, .7, .7]), can_hover => 1, can_events => 1, fontsize => 0.8) for 0 .. $#$m; } } else { $ok or $label->set_text ("error while contacting metaserver"); } }; } sub metaserver_dialog { my $vbox = new CFPlus::UI::VBox; my $table = new CFPlus::UI::Table; $vbox->add (new CFPlus::UI::ScrolledWindow expand => 1, child => $table); my $dialog = new CFPlus::UI::Toplevel title => "Server List", name => 'metaserver_dialog', x => 'center', y => 'center', z => 3, force_w => $::WIDTH * 0.9, force_h => $::HEIGHT * 0.7, child => $vbox, has_close_button => 1, table => $table, on_visibility_change => sub { update_metaserver ($_[0]) if $_[1]; 0 }, ; $dialog } sub server_setup { my $vbox = new CFPlus::UI::VBox; $vbox->add (new CFPlus::UI::FancyFrame label => "Connection Settings", child => (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]), ); $table->add_at (0, 2, new CFPlus::UI::Label valign => 0, align => 1, text => "Host:Port"); { $table->add_at (1, 2, my $vbox = new CFPlus::UI::VBox); $vbox->add ( $HOST_ENTRY = new CFPlus::UI::Entry expand => 1, text => $CFG->{profile}{default}{host}, tooltip => "The hostname or ip address of the Crossfire(+) server to connect to", on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{host} = $value; 0 } ); $vbox->add (new CFPlus::UI::Button expand => 1, text => "Server List", other => $METASERVER, tooltip => "Show a list of available crossfire servers", on_activate => sub { $METASERVER->toggle_visibility; 0 }, on_visibility_change => sub { $METASERVER->hide unless $_[1]; 0 }, ); } $table->add_at (0, 4, new CFPlus::UI::Label valign => 0, align => 1, text => "Username"); $table->add_at (1, 4, new CFPlus::UI::Entry text => $CFG->{profile}{default}{user}, tooltip => "The name of your character on the server", on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{user} = $value } ); $table->add_at (0, 5, new CFPlus::UI::Label valign => 0, align => 1, text => "Password"); $table->add_at (1, 5, new CFPlus::UI::Entry text => $CFG->{profile}{default}{password}, hidden => 1, tooltip => "The password for your character", on_changed => sub { my ($self, $value) = @_; $CFG->{profile}{default}{password} = $value } ); $table->add_at (0, 7, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Size"); $table->add_at (1, 7, new CFPlus::UI::Slider force_w => 100, range => [$CFG->{mapsize}, 10, 100, 0, 1], tooltip => "This is the size of the portion of the map update the server sends you. " . "If you set this to a high value you will be able to see further, " . "but you also increase bandwidth requirements and latency. " . "This option is only used once at log-in.", on_changed => sub { my ($self, $value) = @_; $CFG->{mapsize} = $self->{range}[0] = $value = int $value; 0 }, ); $table->add_at (0, 8, new CFPlus::UI::Label valign => 0, align => 1, text => "Face Prefetch"); $table->add_at (1, 8, new CFPlus::UI::CheckBox state => $CFG->{face_prefetch}, tooltip => "Background Image Prefetch\n\n" . "If enabled, the client automatically pre-fetches images from the server. " . "This might increase or create lag, but increases the chances " . "of faces being ready for display when you encounter them. " . "It also uses up server bandwidth on every connect, " . "so only set it if you really need to prefetch images. " . "This option can be set and unset any time.", on_changed => sub { $CFG->{face_prefetch} = $_[1]; 0 }, ); $table->add_at (0, 9, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Rate"); $table->add_at (1, 9, new CFPlus::UI::Entry text => $CFG->{output_rate}, tooltip => "The approximate bandwidth in bytes per second that the server should not exceed " . "when sending images, to ensure interactiveness. When 0 or unset, the server " . "default will be used, which is usually around 100kb/s.", on_changed => sub { $CFG->{output_rate} = $_[1]; 0 }, ); $table->add_at (0, 10, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Count"); $table->add_at (1, 10, new CFPlus::UI::Entry text => $CFG->{output_count}, tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.", on_changed => sub { $CFG->{output_count} = $_[1]; 0 }, ); $table->add_at (0, 11, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Sync"); $table->add_at (1, 11, new CFPlus::UI::Entry text => $CFG->{output_sync}, tooltip => "Should be set to 1 unless you know what you are doing. This option is only used once at log-in.", on_changed => sub { $CFG->{output_sync} = $_[1]; 0 }, ); $table->add_at (1, 12, $LOGIN_BUTTON = new CFPlus::UI::Button expand => 1, align => 0, text => "Login", on_activate => sub { $CONN ? stop_game : start_game; 0 }, ); $vbox->add (new CFPlus::UI::FancyFrame label => "Server Info", child => ($SERVER_INFO = new CFPlus::UI::Label ellipsise => 0), ); $vbox } sub client_setup { my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]; my $row = 0; $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Tip of the day"); $table->add_at (1, $row++, new CFPlus::UI::CheckBox state => $CFG->{show_tips}, tooltip => "Show the Tip of the day window at startup?", on_changed => sub { my ($self, $value) = @_; $CFG->{show_tips} = $value; 0 } ); $table->add_at (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Messages Window Size"); $table->add_at (1, $row++, my $saycmd = new CFPlus::UI::Entry text => $CFG->{logview_max_par}, tooltip => "This is maximum number of messages remembered in the Messages window. If the server " . "sends more messages than this number, older messages get removed to save memory and " . "computing time. A value of 0 disables this feature, but that is not recommended.", on_changed => sub { my ($self, $value) = @_; $MESSAGE_WINDOW->set_max_para ($CFG->{logview_max_par} = $value*1); 0 }, ); $table } sub autopickup_setup { my $r = new CFPlus::UI::ScrolledWindow ( expand => 1, scroll_y => 1 ); $r->add (my $table = new CFPlus::UI::Table row_expand => [0], col_expand => [0, 1, 0, 1], ); for ( ["General", 0, 0, ["Enable autopickup" => PICKUP_NEWMODE, \$PICKUP_ENABLE], ["Inhibit autopickup" => PICKUP_INHIBIT], ["Stop before pickup" => PICKUP_STOP], ["Debug autopickup" => PICKUP_DEBUG], ], ["Weapons", 0, 6, ["All weapons" => PICKUP_ALLWEAPON], ["Missile weapons" => PICKUP_MISSILEWEAPON], ["Bows" => PICKUP_BOW], ["Arrows" => PICKUP_ARROW], ], ["Armour", 0, 12, ["Helmets" => PICKUP_HELMET], ["Shields" => PICKUP_SHIELD], ["Body Armour" => PICKUP_ARMOUR], ["Boots" => PICKUP_BOOTS], ["Gloves" => PICKUP_GLOVES], ["Cloaks" => PICKUP_CLOAK], ], ["Readables", 2, 0, ["Spellbooks" => PICKUP_SPELLBOOK], ["Skillscrolls" => PICKUP_SKILLSCROLL], ["Normal Books/Scrolls" => PICKUP_READABLES], ], ["Misc", 2, 5, ["Food" => PICKUP_FOOD], ["Drinks" => PICKUP_DRINK], ["Valuables (Money, Gems)" => PICKUP_VALUABLES], ["Keys" => PICKUP_KEY], ["Magical Items" => PICKUP_MAGICAL], ["Potions" => PICKUP_POTION], ["Magic Devices" => PICKUP_MAGIC_DEVICE], ["Ignore cursed" => PICKUP_NOT_CURSED], ["Jewelery" => PICKUP_JEWELS], ["Flesh" => PICKUP_FLESH], ], ["Weight/Value ratio", 2, 17] ) { my ($title, $x, $y, @bits) = @$_; $table->add_at ($x, $y, new CFPlus::UI::Label text => $title, align => 1, fg => [1, 1, 0]); for (@bits) { ++$y; my $mask = $_->[1]; $table->add_at ($x , $y, new CFPlus::UI::Label text => $_->[0], align => 1, expand => 1); $table->add_at ($x+1, $y, my $checkbox = new CFPlus::UI::CheckBox state => $::CFG->{pickup} & $mask, on_changed => sub { my ($box, $value) = @_; if ($value) { $::CFG->{pickup} |= $mask; } else { $::CFG->{pickup} &= ~$mask; } $::CONN->send_command ("pickup $::CFG->{pickup}") if defined $::CONN; 0 }); ${$_->[2]} = $checkbox if $_->[2]; } } $table->add_at (2, 18, new CFPlus::UI::ValSlider range => [$::CFG->{pickup} & 0xF, 0, 16, 1, 1], template => ">= 99", to_value => sub { ">= " . 5 * $_[0] }, on_changed => sub { my ($slider, $value) = @_; $::CFG->{pickup} &= ~0xF; $::CFG->{pickup} |= int $value if $value; 1; }); $table->add_at (3, 18, new CFPlus::UI::Button text => "set", on_activate => sub { $::CONN->send_command ("pickup $::CFG->{pickup}") if defined $::CONN; 0 }); $r } my %SORT_ORDER = ( type => undef, mtime => sub { my $NOW = time; sort { my $atime = $a->{mtime} - $NOW; $atime = $atime < 5 * 60 ? int $atime / 60 : 6; my $btime = $b->{mtime} - $NOW; $btime = $btime < 5 * 60 ? int $btime / 60 : 6; ($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED) or $btime <=> $atime or $a->{type} <=> $b->{type} } @_ }, weight => sub { sort { $a->{weight} * ($a->{nrof} || 1) <=> $b->{weight} * ($b->{nrof} || 1) or $a->{type} <=> $b->{type} } @_ }, ); sub inventory_widget { my $hb = new CFPlus::UI::HBox homogeneous => 1; $hb->add (my $vb1 = new CFPlus::UI::VBox); $vb1->add (new CFPlus::UI::Label align => 0, text => "Player"); $vb1->add (my $hb1 = new CFPlus::UI::HBox); use sort 'stable'; $hb1->add (new CFPlus::UI::Selector value => $::CFG->{inv_sort}, options => [ [type => "Type/Name"], [mtime => "Recent/Normal/Locked"], [weight => "Weight/Type"], ], on_changed => sub { $::CFG->{inv_sort} = $_[1]; $INV->set_sort_order ($SORT_ORDER{$_[1]}); }, ); $hb1->add (new CFPlus::UI::Label text => "Weight: ", align => 1, expand => 1); #TODO# update to weigh/maxweight $hb1->add ($STATWIDS->{i_weight} = new CFPlus::UI::Label align => -1); $vb1->add (my $sw1 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1); $sw1->add ($INV = new CFPlus::UI::Inventory); $INV->set_sort_order ($SORT_ORDER{$::CFG->{inv_sort}}); $hb->add (my $vb2 = new CFPlus::UI::VBox); $vb2->add ($INV_RIGHT_HB = new CFPlus::UI::HBox); $vb2->add (my $sw2 = new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1); $sw2->add ($INVR = new CFPlus::UI::Inventory); # XXX: Call after $INVR = ... because set_opencont sets the items CFPlus::Protocol::set_opencont ($::CONN, 0, "Floor"); $hb } sub toggle_player_page { my ($widget) = @_; if ($PL_WINDOW->{visible} && $PL_NOTEBOOK->get_current_page == $widget) { $PL_WINDOW->hide; } else { $PL_NOTEBOOK->set_current_page ($widget); $PL_WINDOW->show; } } sub player_window { my $plwin = $PL_WINDOW = new CFPlus::UI::Toplevel x => "center", y => "center", force_w => $WIDTH * 9/10, force_h => $HEIGHT * 9/10, title => "Player", name => "playerbook", has_close_button => 1 ; my $ntb = $PL_NOTEBOOK = new CFPlus::UI::Notebook expand => 1; $ntb->add_tab ( "Statistics (F2)" => $STATS_PAGE = stats_window, "Shows statistics, where all your Stats and Resistances are shown." ); $ntb->add_tab ( "Skills (F3)" => $SKILL_PAGE = skill_window, "Shows all your Skills." ); my $spellsw = $SPELL_PAGE = new CFPlus::UI::ScrolledWindow (expand => 1, scroll_y => 1); $spellsw->add ($SPELL_LIST = new CFPlus::UI::SpellList); $ntb->add_tab ( "Spellbook (F4)" => $spellsw, "Displays all spells you have and lets you edit keyboard shortcuts for them." ); $ntb->add_tab ( "Inventory (F5)" => $INVENTORY_PAGE = inventory_widget, "Toggles the inventory window, where you can manage your loot (or treasures :). " . "You can also hit the Tab-key to show/hide the Inventory." ); $ntb->add_tab (Pickup => autopickup_setup, "Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them."); $ntb->set_current_page ($INVENTORY_PAGE); $plwin->add ($ntb); $plwin } sub keyboard_setup { CFPlus::Macro::keyboard_setup } sub help_window { my $win = new CFPlus::UI::Toplevel x => 'center', y => 'center', z => 4, name => 'doc_browser', force_w => int $WIDTH * 7/8, force_h => int $HEIGHT * 7/8, title => "Help Browser", has_close_button => 1; $win->add (my $vbox = new CFPlus::UI::VBox); $vbox->add (new CFPlus::UI::FancyFrame label => "Navigation", child => (my $buttons = new CFPlus::UI::HBox), ); $vbox->add (my $viewer = new CFPlus::UI::TextScroller expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4); my @history; my @future; my $curnode; my $load_node; $load_node = sub { my ($node, $para) = @_; $buttons->clear; $buttons->add (new CFPlus::UI::Button text => "⇤", tooltip => "back to the starting page", on_activate => sub { unshift @future, [$curnode, $viewer->current_paragraph] if $curnode; unshift @future, @history; @history = (); $load_node->(@{shift @future}); }, ); if (@history) { $buttons->add (new CFPlus::UI::Button text => "⋘", tooltip => "back to " . (CFPlus::asxml CFPlus::Pod::full_path $history[-1][0]) . "", on_activate => sub { unshift @future, [$curnode, $viewer->current_paragraph] if $curnode; $load_node->(@{pop @history}); }, ); } if (@future) { $buttons->add (new CFPlus::UI::Button text => "⋙", tooltip => "forward to " . (CFPlus::asxml CFPlus::Pod::full_path $future[0][0]) . "", on_activate => sub { push @history, [$curnode, $viewer->current_paragraph]; $load_node->(@{shift @future}); }, ); } $buttons->add (new CFPlus::UI::Label text => " "); my @path = CFPlus::Pod::full_path_of $node; pop @path; # drop current node for my $node (@path) { $buttons->add (new CFPlus::UI::Button text => $node->{kw}[0], tooltip => "go to " . (CFPlus::asxml CFPlus::Pod::full_path $node) . "", on_activate => sub { push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = (); $load_node->($node); }, ); $buttons->add (new CFPlus::UI::Label text => "/"); } $buttons->add (new CFPlus::UI::Label text => $node->{kw}[0], padding_x => 4, padding_y => 4); $curnode = $node; $viewer->clear; $viewer->add_paragraph (CFPlus::Pod::as_paragraphs CFPlus::Pod::section_of $curnode); $viewer->scroll_to ($para); }; $load_node->(CFPlus::Pod::find pod => "mainpage"); $CFPlus::Pod::goto_document = sub { my (@path) = @_; push @history, [$curnode, $viewer->current_paragraph] if $curnode; @future = (); $load_node->((CFPlus::Pod::find @path)[0]); $win->show; }; $win } sub open_string_query { my ($title, $cb, $txt, $tooltip) = @_; my $dialog = new CFPlus::UI::Toplevel x => "center", y => "center", z => 50, force_w => $WIDTH * 4/5, title => $title; $dialog->add ( my $e = new CFPlus::UI::Entry on_activate => sub { $cb->(@_); $dialog->hide; 0 }, on_key_down => sub { $_[1]->{sym} == 27 and $dialog->hide; 0 }, tooltip => $tooltip ); $e->grab_focus; $e->set_text ($txt) if $txt; $dialog->show; } sub open_quit_dialog { unless ($QUIT_DIALOG) { $QUIT_DIALOG = new CFPlus::UI::Toplevel x => "center", y => "center", z => 50, title => "Really Quit?", on_key_down => sub { my ($dialog, $ev) = @_; $ev->{sym} == 27 and $dialog->hide; } ; $QUIT_DIALOG->add (my $vb = new CFPlus::UI::VBox expand => 1); $vb->add (new CFPlus::UI::Label text => "You should find a savebed and apply it first!", max_w => $WIDTH * 0.25, ellipsize => 0, ); $vb->add (my $hb = new CFPlus::UI::HBox expand => 1); $hb->add (new CFPlus::UI::Button text => "Ok", expand => 1, on_activate => sub { $QUIT_DIALOG->hide; 0 }, ); $hb->add (new CFPlus::UI::Button text => "Quit anyway", expand => 1, on_activate => sub { exit }, ); } $QUIT_DIALOG->show; $QUIT_DIALOG->grab_focus; } sub show_tip_of_the_day { # find all tips my @tod = CFPlus::Pod::find tip_of_the_day => "*"; CFPlus::DB::get state => "tip_of_the_day", sub { my ($todindex) = @_; $todindex = 0 if $todindex >= @tod; CFPlus::DB::put state => tip_of_the_day => $todindex + 1, sub { }; # create dialog my $dialog; my $close = sub { $dialog->destroy; }; $dialog = new CFPlus::UI::Toplevel x => "center", y => "center", z => 3, name => 'tip_of_the_day', force_w => int $WIDTH * 4/9, force_h => int $WIDTH * 2/9, title => "Tip of the day #" . (1 + $todindex), child => my $vbox = new CFPlus::UI::VBox, has_close_button => 1, on_delete => $close, ; $vbox->add (my $viewer = new CFPlus::UI::TextScroller expand => 1, fontsize => 0.8, padding_x => 4, padding_y => 4); $viewer->add_paragraph (CFPlus::Pod::as_paragraphs CFPlus::Pod::section_of $tod[$todindex]); $vbox->add (my $table = new CFPlus::UI::Table col_expand => [0, 1]); $table->add_at (0, 0, new CFPlus::UI::Button text => "Close", tooltip => "Close the tip of the day window. To never see it again, disable the tip of the day in the Server Setup.", on_activate => $close, ); $table->add_at (2, 0, new CFPlus::UI::Button text => "Next", tooltip => "Show the next Tip of the day.", on_activate => sub { $close->(); &show_tip_of_the_day; }, ); $dialog->show; }; } sub sdl_init { CFPlus::SDL_Init and die "SDL::Init failed!\n"; } sub video_init { $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES; my ($old_w, $old_h) = ($WIDTH, $HEIGHT); ($WIDTH, $HEIGHT, my ($rgb, $alpha)) = @{ $SDL_MODES[$CFG->{sdl_mode}] }; $FULLSCREEN = $CFG->{fullscreen}; $FAST = $CFG->{fast}; CFPlus::SDL_SetVideoMode $WIDTH, $HEIGHT, $rgb, $alpha, $FULLSCREEN or die "SDL_SetVideoMode failed: " . (CFPlus::SDL_GetError) . "\n"; $SDL_ACTIVE = 1; $LAST_REFRESH = time - 0.01; CFPlus::OpenGL::init; $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize}; $CFPlus::UI::ROOT->configure (0, 0, $WIDTH, $HEIGHT);#d# ############################################################################# if ($DEBUG_STATUS) { CFPlus::UI::rescale_widgets $WIDTH / $old_w, $HEIGHT / $old_h; } else { # create the widgets $DEBUG_STATUS = new CFPlus::UI::Label padding => 0, z => 100, force_x => "max", force_y => 0; $DEBUG_STATUS->show; $STATUSBOX = new CFPlus::UI::Statusbox; $STATUSBOX->add ("Use Alt-Enter to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]); (new CFPlus::UI::Frame bg => [0, 0, 0, 0.4], force_x => 0, force_y => "max", child => $STATUSBOX, )->show; CFPlus::UI::Toplevel->new ( title => "Map", name => "mapmap", x => 0, y => $FONTSIZE + 8, border_bg => [1, 1, 1, 192/255], bg => [1, 1, 1, 0], child => ($MAPMAP = new CFPlus::MapWidget::MapMap tooltip => "Map. On servers that support this feature, this will display an overview of the surrounding areas.", ), )->show; $MAPWIDGET = new CFPlus::MapWidget; $MAPWIDGET->connect (activate_console => sub { my ($mapwidget, $preset) = @_; $MESSAGE_WINDOW->activate_console ($preset) if $MESSAGE_WINDOW; }); $MAPWIDGET->show; $MAPWIDGET->grab_focus; $SETUP_DIALOG = new CFPlus::UI::Toplevel title => "Setup", name => "setup_dialog", x => 'center', y => 'center', z => 2, force_w => $::WIDTH * 0.6, force_h => $::HEIGHT * 0.6, has_close_button => 1, ; $METASERVER = metaserver_dialog; $MESSAGE_WINDOW = new CFPlus::UI::MessageWindow; $SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFPlus::UI::Notebook expand => 1, debug => 1, filter => new CFPlus::UI::ScrolledWindow expand => 1, scroll_y => 1); $SETUP_NOTEBOOK->add_tab (Server => $SETUP_SERVER = server_setup, "Configure the server to play on, your username, password and other server-related options."); $SETUP_NOTEBOOK->add_tab (Client => client_setup, "Configure various client-specific settings."); $SETUP_NOTEBOOK->add_tab (Graphics => graphics_setup, "Configure the video mode, performance, fonts and other graphical aspects of the game."); $SETUP_NOTEBOOK->add_tab (Audio => audio_setup, "Configure the use of audio, sound effects and background music."); $SETUP_NOTEBOOK->add_tab (Keyboard => $SETUP_KEYBOARD = keyboard_setup, "Lets you define, edit and delete key bindings." . "There is a shortcut for making bindings: Control-Insert opens the binding editor " . "with nothing set and the recording started. After doing the actions you " . "want to record press Insert and you will be asked to press a key-combo. " . "After pressing the combo the binding will be saved automatically and the " . "binding editor closes"); $SETUP_NOTEBOOK->add_tab (Debug => debug_setup, "Some debuggin' options. Do not ask."); $BUTTONBAR = new CFPlus::UI::Buttonbar x => 0, y => 0, z => 200; # put on top $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Setup", other => $SETUP_DIALOG, tooltip => "Toggles a dialog where you can configure all aspects of this client."); $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Message Window", other => $MESSAGE_WINDOW, tooltip => "Toggles the server message log, where the client collects all messages from the server."); 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 $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Playerbook", other => player_window, tooltip => "Toggles the player view, where you can manage Inventory, Spells, Skills and see your Stats."); $BUTTONBAR->add (new CFPlus::UI::Button text => "Save Config", tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.", on_activate => sub { $::CFG->{layout} = CFPlus::UI::get_layout; CFPlus::write_cfg "$Crossfire::VARDIR/cfplusrc"; status "Configuration Saved"; 0 }, ); $BUTTONBAR->add (new CFPlus::UI::Flopper text => "Help!", other => $HELP_WINDOW = help_window, tooltip => "View Documentation"); $BUTTONBAR->add (new CFPlus::UI::Button text => "Quit", tooltip => "Terminates the program", on_activate => sub { if ($CONN) { open_quit_dialog; } else { exit; } 0 }, ); $BUTTONBAR->show; $SETUP_DIALOG->show; } $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]); } sub video_shutdown { CFPlus::OpenGL::shutdown; undef $SDL_ACTIVE; } sub audio_channel_finished { my ($channel) = @_; #warn "channel $channel finished\n";#d# } sub audio_music_set { my ($songs) = @_; my @want = grep $_, map $CONN->{music_meta}{$_}, @$songs; if (@want) { @MUSIC_WANT = @want; &audio_music_changed (); } } sub audio_music_start { my $path = $MUSIC_PLAYING->{path} or return; CFPlus::DB::prefetch_file $path, 1024_000, sub { return unless $SDL_MIXER; # music might have changed... $path eq $MUSIC_PLAYING->{path} or return &audio_music_start (); $MUSIC_PLAYER = new_from_file CFPlus::MixMusic $path; my $NOW = time; if ($MUSIC_PLAYING->{stop_time} > $NOW - $MUSIC_RESUME) { my $pos = $MUSIC_PLAYING->{stop_pos}; $MUSIC_PLAYER->fade_in_pos (0, 1000, $pos); $MUSIC_START = time - $pos; } else { $MUSIC_PLAYER->play (0); $MUSIC_START = time; } delete $MUSIC_PLAYING->{stop_time}; delete $MUSIC_PLAYING->{stop_pos}; } } sub audio_music_changed { return unless $CFG->{bgm_enable}; return unless $SDL_MIXER; # default MUSIC_WANT == MUSIC_DEFAULT @MUSIC_WANT = { path => CFPlus::find_rcfile "music/$MUSIC_DEFAULT" } unless @MUSIC_WANT; # if the currently playing song is acceptable, let it continue return if $MUSIC_PLAYING && grep $MUSIC_PLAYING->{path} eq $_->{path}, @MUSIC_WANT; my $NOW = time; if ($MUSIC_PLAYING) { $MUSIC_PLAYING->{stop_time} = $NOW; $MUSIC_PLAYING->{stop_pos} = $NOW - $MUSIC_START; CFPlus::MixMusic::fade_out 1000; } else { # sort by stop time, oldest first @MUSIC_WANT = sort { $a->{stop_time} <=> $b->{stop_time} } @MUSIC_WANT; # if the most recently-played piece played very recently, # resume it, else choose the oldest piece for rotation. $MUSIC_PLAYING = $MUSIC_WANT[-1]{stop_time} > $NOW - $MUSIC_RESUME ? $MUSIC_WANT[-1] : $MUSIC_WANT[0]; audio_music_start; } } sub audio_music_finished { $MUSIC_PLAYING = undef; undef $MUSIC_PLAYER; audio_music_changed; } sub audio_init { if ($CFG->{audio_enable}) { if (open my $fh, "<", CFPlus::find_rcfile "sounds/config") { $SDL_MIXER = !CFPlus::Mix_OpenAudio; unless ($SDL_MIXER) { status "Unable to open sound device: there will be no sound"; return; } CFPlus::Mix_AllocateChannels 8; CFPlus::MixMusic::volume $CFG->{bgm_volume} * 128; audio_music_finished; local $_; while (<$fh>) { next if /^\s*#/; next if /^\s*$/; my ($file, $volume, $event) = split /\s+/, $_, 3; push @SOUNDS, "$volume,$file"; $AUDIO_CHUNKS{"$volume,$file"} ||= do { my $chunk = new_from_file CFPlus::MixChunk CFPlus::find_rcfile "sounds/$file"; $chunk->volume ($volume * 128 / 100); $chunk }; } } else { status "unable to open sound config: $!"; } } else { undef $SDL_MIXER; } } sub audio_shutdown { CFPlus::Mix_CloseAudio if $SDL_MIXER; undef $SDL_MIXER; @SOUNDS = (); %AUDIO_CHUNKS = (); } my %animate_object; my $animate_timer; my $fps = 9; my %demo;#d# sub force_refresh { $fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05; debug sprintf "%3.2f", $fps if $ENV{CFPLUS_DEBUG} & 4; $CFPlus::UI::ROOT->draw; $WANT_REFRESH = 0; $CAN_REFRESH = 0; $LAST_REFRESH = $NOW; CFPlus::SDL_GL_SwapBuffers; } my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub { $NOW = time; ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_) for CFPlus::poll_events; if (%animate_object) { $_->animate ($LAST_REFRESH - $NOW) for values %animate_object; ++$WANT_REFRESH; } if ($WANT_REFRESH) { force_refresh; } else { $CAN_REFRESH = 1; } }); sub animation_start { my ($widget) = @_; $animate_object{$widget} = $widget; } sub animation_stop { my ($widget) = @_; delete $animate_object{$widget}; } # check once/second for faces that need to be prefetched # this should, of course, only run on demand, but # SDL forces worse things on us.... Event->timer (after => 1, interval => 0.25, cb => sub { $CONN->face_prefetch if $CONN; }); %SDL_CB = ( CFPlus::SDL_QUIT => sub { exit; }, CFPlus::SDL_VIDEORESIZE => sub { }, CFPlus::SDL_VIDEOEXPOSE => sub { CFPlus::UI::full_refresh; }, CFPlus::SDL_ACTIVEEVENT => sub { # not useful, as APPACTIVE include sonly iconified state, not unmapped # printf "active %x %x %x\n", $_[0]{gain}, $_[0]{state}, CFPlus::SDL_GetAppState;#d# # printf "a %x\n", CFPlus::SDL_GetAppState & CFPlus::SDL_APPACTIVE;#d# # printf "A\n" if $_[0]{state} & CFPlus::SDL_APPACTIVE; # printf "K\n" if $_[0]{state} & CFPlus::SDL_APPINPUTFOCUS; # printf "M\n" if $_[0]{state} & CFPlus::SDL_APPMOUSEFOCUS; }, CFPlus::SDL_KEYDOWN => sub { if ($_[0]{mod} & CFPlus::KMOD_ALT && $_[0]{sym} == 13) { # alt-enter $FULLSCREEN_ENABLE->toggle; video_shutdown; video_init; } else { CFPlus::UI::feed_sdl_key_down_event ($_[0]); } }, CFPlus::SDL_KEYUP => \&CFPlus::UI::feed_sdl_key_up_event, CFPlus::SDL_MOUSEMOTION => \&CFPlus::UI::feed_sdl_motion_event, CFPlus::SDL_MOUSEBUTTONDOWN => \&CFPlus::UI::feed_sdl_button_down_event, CFPlus::SDL_MOUSEBUTTONUP => \&CFPlus::UI::feed_sdl_button_up_event, CFPlus::SDL_USEREVENT => sub { if ($_[0]{code} == 1) { audio_channel_finished $_[0]{data1}; } elsif ($_[0]{code} == 0) { audio_music_finished; } }, ); ############################################################################# $SIG{INT} = $SIG{TERM} = sub { exit }; { CFPlus::read_cfg "$Crossfire::VARDIR/cfplusrc"; CFPlus::DB::Server::run; CFPlus::UI::set_layout ($::CFG->{layout}); my %DEF_CFG = ( sdl_mode => 0, width => 640, height => 480, fullscreen => 0, fast => 0, map_scale => 1, fow_enable => 1, fow_intensity => 0, map_smoothing => 1, gui_fontsize => 1, log_fontsize => 0.7, gauge_fontsize => 1, gauge_size => 0.35, stat_fontsize => 0.7, mapsize => 100, audio_enable => 1, bgm_enable => 1, bgm_volume => 0.25, face_prefetch => 0, output_sync => 1, output_count => 1, output_rate => "", pickup => 0, inv_sort => "mtime", default => "profile", # default profile show_tips => 1, logview_max_par => 1000, ); while (my ($k, $v) = each %DEF_CFG) { $CFG->{$k} = $v unless exists $CFG->{$k}; } $CFG->{profile}{default}{host} ||= "crossfire.schmorp.de"; $PROFILE = $CFG->{profile}{default}; # convert old bindings (only default profile matters) if (my $bindings = delete $PROFILE->{bindings}) { while (my ($mod, $syms) = each %$bindings) { while (my ($sym, $cmds) = each %$syms) { push @{ $PROFILE->{macro} }, { accelkey => [$mod*1, $sym*1], action => $cmds, }; } } } sdl_init; @SDL_MODES = CFPlus::SDL_ListModes 8, 8; @SDL_MODES = CFPlus::SDL_ListModes 5, 0 unless @SDL_MODES; @SDL_MODES or CFPlus::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)"; @SDL_MODES = sort { $a->[0] * $a->[1] <=> $b->[0] * $b->[1] } @SDL_MODES; $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} > @SDL_MODES; { my @fonts = map CFPlus::find_rcfile "fonts/$_", qw( DejaVuSans.ttf DejaVuSansMono.ttf DejaVuSans-Bold.ttf DejaVuSansMono-Bold.ttf DejaVuSans-Oblique.ttf DejaVuSansMono-Oblique.ttf DejaVuSans-BoldOblique.ttf DejaVuSansMono-BoldOblique.ttf ); CFPlus::add_font $_ for @fonts; CFPlus::pango_init; $FONT_PROP = new_from_file CFPlus::Font $fonts[0]; $FONT_FIXED = new_from_file CFPlus::Font $fonts[1]; $FONT_PROP->make_default; } # compare mono (ft) vs. rgba (cairo) # ft - 1.8s, cairo 3s, even in alpha-only mode # for my $rgba (0..1) { # my $t1 = Time::HiRes::time; # for (1..1000) { # my $layout = CFPlus::Layout->new ($rgba); # $layout->set_text ("hallo" x 100); # $layout->render; # } # my $t2 = Time::HiRes::time; # warn $t2-$t1; # } $startup_done->(); video_init; audio_init; } show_tip_of_the_day if $CFG->{show_tips}; Event::loop; #CFPlus::SDL_Quit; #CFPlus::_exit 0; END { CFPlus::SDL_Quit; CFPlus::DB::Server::stop; } =head1 NAME cfplus - A Crossfire+ and Crossfire game client =head1 SYNOPSIS Just run it - no commandline arguments are supported. =head1 USAGE cfplus utilises OpenGL for all UI elements and the game. It is supposed to be used fullscreen and interactively. =head1 DEBUGGING CFPLUS_DEBUG - environment variable 1 draw borders around widgets 2 add low-level widget info to tooltips 4 show fps 8 suppress tooltips =head1 AUTHOR Marc Lehmann , Robin Redeker