#!/opt/bin/perl my $startup_done = sub { }; # 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 while (my ($filename, $zip) = each %PAR::LibCache) { for ($zip->memberNames) { next unless /^root\/(.*)/; $zip->extractMember ($_, "$ENV{PAR_TEMP}/$1") unless -e "$ENV{PAR_TEMP}/$1"; } } # TODO: pango-rc file, anybody? unshift @INC, $ENV{PAR_TEMP}; } } # 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::UI; use CFPlus::UI::Inventory; use CFPlus::UI::SpellList; 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 $LOGVIEW; our $CONSOLE; 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 @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; our $IN_BUILD_MODE; our $BUILD_BUTTON; 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) = @_; my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0]; $para->{markup} = "$time $para->{markup}"; $LOGVIEW->add_paragraph ($para); $LOGVIEW->scroll_to_bottom; } 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.4, 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) { $dialog->{tooltip} = "#charcreation_focus"; if ($prompt =~ /Now choose a character|Press any key for the next race/i) { $MESSAGE_WINDOW->show; 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; $table->add (0, 0, new CFPlus::UI::Button text => "Next Race", on_activate => sub { $conn->send ("reply n"); destroy_query_dialog $conn; 0 }, ); $table->add (2, 0, new CFPlus::UI::Button text => "Accept", on_activate => sub { $conn->send ("reply d"); destroy_query_dialog $conn; 0 }, ); 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; } $STATS_PAGE->show; $MESSAGE_WINDOW->hide; 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 (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 (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 (2, 1, new CFPlus::UI::HBox children => [$sw1, $sw2]); # right: accept $table->add (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, logview => $LOGVIEW, statusbox => $STATUSBOX, map => $MAP, mapmap => $MAPMAP, query => \&server_query, 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; 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 (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "OpenGL Info"); $table->add (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) . ""); $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Video Mode"); $table->add (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]); $hbox->add (my $mode_label = new CFPlus::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999"); $mode_slider->connect (changed => sub { my ($self, $value) = @_; $CFG->{sdl_mode} = $self->{range}[0] = $value = int $value; $mode_label->set_text (sprintf "%dx%d", @{$SDL_MODES[$value]}); }); $mode_slider->emit (changed => $mode_slider->{range}[0]); $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fullscreen"); $table->add (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 (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fast & Ugly"); $table->add (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 (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Scale"); $table->add (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 (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fog of War"); $table->add (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 (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "FoW Intensity"); $table->add (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 (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "FoW Smooth"); $table->add (1, $row++, new CFPlus::UI::CheckBox state => $CFG->{fow_smooth}, tooltip => "Smooth the Fog-of-War a bit to make it more realistic. Changes are instant.", on_changed => sub { my ($self, $value) = @_; $CFG->{fow_smooth} = $value; status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFPlus::OpenGL::GL_VERSION < 1.2; 0 } ); $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "GUI Fontsize"); $table->add (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 (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Message Fontsize"); $table->add (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 { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]); 0 }, ); $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Gauge fontsize"); $table->add (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 (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Gauge size"); $table->add (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 } ); $table->add (1, $row++, new CFPlus::UI::Button expand => 1, align => 0, text => "Apply", tooltip => "Apply the video settings", on_activate => sub { video_shutdown (); video_init (); 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 (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Audio Enable"); $table->add (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 (0, 9, new CFPlus::UI::Label valign => 0, align => 1, text => "Effects Volume"); # $table->add (1, 8, new CFPlus::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], on_changed => sub { # $CFG->{effects_volume} = $_[1]; # }); $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Background Music"); $table->add (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 (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 (0, 0, new CFPlus::UI::Label text => "Widget Borders"); $table->add (1, 0, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 1; 0 }); $table->add (0, 1, new CFPlus::UI::Label text => "Tooltip Widget Info"); $table->add (1, 1, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 2; 0 }); $table->add (0, 2, new CFPlus::UI::Label text => "Show FPS"); $table->add (1, 2, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 4; 0 }); $table->add (0, 3, new CFPlus::UI::Label text => "Suppress Tooltips"); $table->add (1, 3, new CFPlus::UI::CheckBox on_changed => sub { $ENV{CFPLUS_DEBUG} ^= 8; 0 }); $table->add (0, 4, new CFPlus::UI::Button text => "die on click(tm)", on_activate => sub { die "violator" } ); my @default_smooth = (0.05, 0.13, 0.05, 0.13, 0.30, 0.13, 0.05, 0.13, 0.05); for my $x (0..2) { for my $y (0 .. 2) { $table->add ($x + 3, $y, new CFPlus::UI::Entry text => $default_smooth[$x * 3 + $y], on_changed => sub { $MAP->{smooth_matrix}[$x * 3 + $y] = $_[1] if $MAP; 0 }, ); } } $table->add (0, 5, new CFPlus::UI::TextEdit text => "line1\0152\0153");#d# $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 ($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 ($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 ($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 ($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 ($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 (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 ($_, 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 (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 ($_, $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 (0, 2, new CFPlus::UI::Label valign => 0, align => 1, text => "Host:Port"); { $table->add (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 (0, 4, new CFPlus::UI::Label valign => 0, align => 1, text => "Username"); $table->add (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 (0, 5, new CFPlus::UI::Label valign => 0, align => 1, text => "Password"); $table->add (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 (0, 7, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Size"); $table->add (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 (0, 8, new CFPlus::UI::Label valign => 0, align => 1, text => "Face Prefetch"); $table->add (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 (0, 9, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Rate"); $table->add (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 (0, 10, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Count"); $table->add (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 (0, 11, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Sync"); $table->add (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 (1, 12, $LOGIN_BUTTON = new CFPlus::UI::Button expand => 1, align => 0, text => "Login", on_activate => sub { $CONN ? stop_game : start_game; 0 }, ); $table->add (0, 13, new CFPlus::UI::Label valign => 0, align => 1, text => "Chat Command"); $table->add (1, 13, my $saycmd = new CFPlus::UI::Entry text => $CFG->{say_command}, tooltip => "This is the command that will be used if you write a line in the message window entry or press \" in the map window. " . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. " . "But you could also set it to tell playername to only chat with that user.", on_changed => sub { my ($self, $value) = @_; $CFG->{say_command} = $value; 0 } ); $table->add (0, 14, new CFPlus::UI::Label valign => 0, align => 1, text => "Tip of the day"); $table->add (1, 14, my $saycmd = 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 } ); $vbox->add (new CFPlus::UI::FancyFrame label => "Server Info", child => ($SERVER_INFO = new CFPlus::UI::Label ellipsise => 0), ); $vbox } sub message_window { my $window = new CFPlus::UI::Toplevel name => "message_window", title => "Messages", border_bg => [1, 1, 1, 1], x => "max", y => 0, force_w => $::WIDTH * 0.4, force_h => $::HEIGHT * 0.5, child => (my $vbox = new CFPlus::UI::VBox), has_close_button => 1; $vbox->add ($LOGVIEW); $vbox->add (my $input = new CFPlus::UI::Entry tooltip => "Chat Box. If you enter a text and press return/enter here, the current communication command " . "from the client setup will be prepended (e.g. shout, chat...). " . "If you prepend a slash (/), you will submit a command instead (similar to IRC). " . "A better way to submit commands (and the occasional chat command) is often the map command completer.", on_focus_in => sub { my ($input, $prev_focus) = @_; delete $input->{refocus_map}; if ($prev_focus == $MAPWIDGET && $input->{auto_activated}) { $input->{refocus_map} = 1; } delete $input->{auto_activated}; 0 }, on_activate => sub { my ($input, $text) = @_; $input->set_text (''); if ($text =~ /^\/(.*)/) { $::CONN->user_send ($1); } else { my $say_cmd = $::CFG->{say_command} || 'say'; $::CONN->user_send ("$say_cmd $text"); } if ($input->{refocus_map}) { delete $input->{refocus_map}; $MAPWIDGET->focus_in } 0 }, on_escape => sub { $MAPWIDGET->grab_focus; 0 }, ); $CONSOLE = { window => $window, input => $input, }; $window } sub autopickup_setup { my $table = new CFPlus::UI::Table; 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 ($x, $y, new CFPlus::UI::Label text => $title, align => 1, fg => [1, 1, 0]); for (@bits) { ++$y; my $mask = $_->[1]; $table->add ($x , $y, new CFPlus::UI::Label text => $_->[0], align => 1, expand => 1); $table->add ($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 (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 (3, 18, new CFPlus::UI::Button text => "set", on_activate => sub { $::CONN->send_command ("pickup $::CFG->{pickup}") if defined $::CONN; 0 }); $table } 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, debug => 1; $ntb->add ( "Statistics (F2)" => $STATS_PAGE = stats_window, "Shows statistics, where all your Stats and Resistances are shown." ); $ntb->add ( "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 ( "Spellbook (F4)" => $spellsw, "Displays all spells you have and lets you edit keyboard shortcuts for them." ); $ntb->add ( "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->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 => "*"; my $todindex = $CFPlus::DB_STATE->get ("tip_of_the_day"); $todindex = 0 if $todindex >= @tod; $CFPlus::DB_STATE->put (tip_of_the_day => $todindex + 1); # 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 (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 (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 { sdl_init; $CFG->{sdl_mode} = 0 if $CFG->{sdl_mode} >= @SDL_MODES; my ($old_w, $old_h) = ($WIDTH, $HEIGHT); ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] }; $FULLSCREEN = $CFG->{fullscreen}; $FAST = $CFG->{fast}; CFPlus::SDL_SetVideoMode $WIDTH, $HEIGHT, $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) = @_; if ($CONSOLE) { $CONSOLE->{input}->{auto_activated} = 1; $CONSOLE->{input}->grab_focus; if ($preset && $CONSOLE->{input}->get_text eq '') { $CONSOLE->{input}->set_text ($preset); } } }); $MAPWIDGET->show; $MAPWIDGET->grab_focus; $LOGVIEW = new CFPlus::UI::TextScroller expand => 1, font => $FONT_FIXED, fontsize => $::CFG->{log_fontsize}, indent => -4, can_hover => 1, can_events => 1, tooltip => "Server Log. This text viewer contains all the messages sent by the server.", ; $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; $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 (Server => $SETUP_SERVER = server_setup, "Configure the server to play on, your username, password and other server-related options."); $SETUP_NOTEBOOK->add (Pickup => autopickup_setup, "Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them."); $SETUP_NOTEBOOK->add (Graphics => graphics_setup, "Configure the video mode, performance, fonts and other graphical aspects of the game."); $SETUP_NOTEBOOK->add (Audio => audio_setup, "Configure the use of audio, sound effects and background music."); $SETUP_NOTEBOOK->add (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 (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 = 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 setup_build_button { my ($enabled) = @_; if ($enabled) { $BUILD_BUTTON->hide if $BUILD_BUTTON; $BUILD_BUTTON ||= new CFPlus::UI::Button text => "Build", tooltip => "Opens the ingame builder", on_activate => sub { if ($CONN) { $CONN->send_ext_req (builder_player_items => sub { open_ingame_editor ($_[0]) if exists $_[0]->{items}; }); } 0 }; $BUTTONBAR->add ($BUILD_BUTTON); } else { $BUILD_BUTTON->hide if $BUILD_BUTTON; } } sub open_ingame_editor { my ($msg) = @_; my $win = new CFPlus::UI::Toplevel x => 0, y => 'center', z => 4, name => 'builder_window', force_w => int $WIDTH * 1/4, force_h => int $HEIGHT * 3/4, title => "In game builder", has_close_button => 1; my $r = new CFPlus::UI::ScrolledWindow ( expand => 1, scroll_y => 1 ); $r->add (my $vb = new CFPlus::UI::VBox); $win->add ($r); $vb->add ( new CFPlus::UI::Button text => "Disable build mode", on_activate => sub { $::IN_BUILD_MODE = undef } ); $vb->add ( new CFPlus::UI::Button text => "ERASE", on_activate => sub { $::IN_BUILD_MODE = { do_erase => 1 } } ); for my $itemarchname ( sort { $msg->{items}->{$a}->{build_arch_name} cmp $msg->{items}->{$b}->{build_arch_name} } keys %{$msg->{items}} ) { my $info = $msg->{items}->{$itemarchname}; $vb->add ( new CFPlus::UI::Button text => $info->{build_arch_name}, on_activate => sub { $::IN_BUILD_MODE = { item => $itemarchname, info => $info }; if (grep { $msg->{items}->{$itemarchname}->{$_} } qw/has_connection has_name has_text/) { build_mode_query_arch_info (); } } ); } $win->show; } sub build_mode_query_arch_info { my ($iteminfo) = $::IN_BUILD_MODE; my $itemarchname = $iteminfo->{item}; my $info = $iteminfo->{info}; my $dialog = new CFPlus::UI::Toplevel x => "center", y => "center", z => 50, force_w => int $WIDTH * 1/2, title => "Enter information for placement of '$itemarchname'", has_close_button => 1; $dialog->add (my $vb = new CFPlus::UI::VBox expand => 1); $vb->add (my $table = new CFPlus::UI::Table expand => 1); my $row = 0; if ($info->{has_name}) { $table->add (0, $row, new CFPlus::UI::Label text => "Name:"); $table->add (1, $row++, new CFPlus::UI::Entry expand => 1, on_changed => sub { $::IN_BUILD_MODE->{name} = $_[1]; 0 }); } if ($info->{has_text}) { $table->add (0, $row, new CFPlus::UI::Label text => "Text:"); $table->add (1, $row++, new CFPlus::UI::Entry expand => 1, on_changed => sub { $::IN_BUILD_MODE->{text} = $_[1]; 0 }); } if ($info->{has_connection}) { $table->add (0, $row, new CFPlus::UI::Label text => "Connection ID:"); $table->add (1, $row++, new CFPlus::UI::Entry expand => 1, on_changed => sub { $::IN_BUILD_MODE->{connection} = $_[1]; 0 }, tooltip => "Enter the connection ID here. The connection ID connects actors like a lever to a gate or a magic ear to a gate" ); } $vb->add (my $hb = new CFPlus::UI::HBox expand => 1); $hb->add (new CFPlus::UI::Button text => "Close", expand => 1, on_activate => sub { $dialog->hide; 0 }, ); $dialog->show; } sub video_shutdown { CFPlus::OpenGL::shutdown; undef $SDL_ACTIVE; } my @bgmusic = qw(game1.ogg game2.ogg game3.ogg game5.ogg game6.ogg ross1.ogg ross2.ogg ross3.ogg ross4.ogg ross5.ogg); #d# my $bgmusic;#TODO#hack#d# sub audio_channel_finished { my ($channel) = @_; #warn "channel $channel finished\n";#d# } sub audio_music_finished { return unless $CFG->{bgm_enable}; # TODO: hack, do play loop and mood music $bgmusic = new_from_file CFPlus::MixMusic CFPlus::find_rcfile "music/$bgmusic[0]"; $bgmusic->play (0); push @bgmusic, shift @bgmusic; } 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: $!"; } } } 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::SDL_PollEvent; 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 { Event::unloop -1; }, 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\n", $_[0]{gain}, $_[0]{state};#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::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.45, fow_smooth => 0, gui_fontsize => 1, log_fontsize => 0.7, gauge_fontsize => 1, gauge_size => 0.35, stat_fontsize => 0.7, mapsize => 100, say_command => 'chat', 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, ); 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 = reverse grep $_->[0] >= 640 && $_->[1] >= 480, CFPlus::SDL_ListModes; @SDL_MODES or CFPlus::fatal "Unable to find a usable video mode\n(hardware accelerated opengl fullscreen)"; $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 } =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