--- deliantra/Deliantra-Client/bin/cfplus 2006/10/01 14:48:51 1.120 +++ deliantra/Deliantra-Client/bin/cfplus 2007/07/20 16:32:04 1.178 @@ -1,24 +1,69 @@ #!/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 ($_, "$ENV{PAR_TEMP}/$1") - unless -e "$ENV{PAR_TEMP}/$1"; + next unless /^root\/(.*)/; + $zip->extractMember ($_, "$tmp/$1") + unless -e "$tmp/$1"; } } - # TODO: pango-rc file, anybody? + 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, $ENV{PAR_TEMP}; + unshift @INC, $tmp; } } @@ -37,28 +82,26 @@ use CFPlus; use CFPlus::OpenGL (); use CFPlus::Protocol; +use CFPlus::DB; use CFPlus::UI; +use CFPlus::UI::Inventory; +use CFPlus::UI::SpellList; use CFPlus::Pod; -use CFPlus::BindingEditor; use CFPlus::MapWidget; +use CFPlus::Macro; $SIG{QUIT} = sub { Carp::cluck "QUIT" }; $SIG{PIPE} = 'IGNORE'; -$Event::Eval = 0; +$Event::Eval = 1; $Event::DIED = sub { - # TODO: display dialog box or so - Carp::cluck $_[1];#d#TODO: remove when stable - return;#d# - CFPlus::fatal ($_[1]); + CFPlus::fatal Carp::longmess $_[1] }; -our $VERSION = '0.9'; - my $MAX_FPS = 60; my $MIN_FPS = 5; # unused as of yet -our $META_SERVER = "crossfire.real-time.com:13326"; +our $META_SERVER = "http://metaserver.schmorp.de/current.json"; our $LAST_REFRESH; our $NOW; @@ -106,6 +149,7 @@ our $STATS_PAGE; our $SKILL_PAGE; our $SPELL_PAGE; +our $SPELL_LIST; our $HELP_WINDOW; our $MESSAGE_WINDOW; @@ -117,6 +161,12 @@ 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 @@ -128,11 +178,11 @@ our $INVR; our $INV_RIGHT_HB; -our $BIND_EDITOR; -our $BIND_UPD_CB; - 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]); } @@ -141,15 +191,44 @@ $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", @@ -158,7 +237,7 @@ ; my @dialog = my $label = new CFPlus::UI::Label - max_w => $::WIDTH * 0.4, + max_w => $::WIDTH * 0.8, ellipsise => 0, text => $prompt; @@ -185,19 +264,17 @@ $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; + $dialog->{tooltip} = "#charcreation_focus"; unshift @dialog, new CFPlus::UI::Label - max_w => $::WIDTH * 0.4, + 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 (0, 0, new CFPlus::UI::Button + $table->add_at (0, 0, new CFPlus::UI::Button text => "Next Race", on_activate => sub { $conn->send ("reply n"); @@ -205,7 +282,7 @@ 0 }, ); - $table->add (2, 0, new CFPlus::UI::Button + $table->add_at (2, 0, new CFPlus::UI::Button text => "Accept", on_activate => sub { $conn->send ("reply d"); @@ -214,6 +291,29 @@ }, ); + 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, @@ -227,9 +327,6 @@ return; } - $STATS_PAGE->show; - $MESSAGE_WINDOW->hide; - unshift @dialog, new CFPlus::UI::Label max_w => $::WIDTH * 0.4, ellipsise => 0, @@ -238,7 +335,7 @@ unshift @dialog, my $table = new CFPlus::UI::Table; # left: re-roll - $table->add (0, 0, new CFPlus::UI::Button + $table->add_at (0, 0, new CFPlus::UI::Button text => "Roll Again", on_activate => sub { $conn->send ("reply y"); @@ -262,7 +359,7 @@ ], ), 1 .. 2; - $table->add (2, 0, new CFPlus::UI::Button + $table->add_at (2, 0, new CFPlus::UI::Button text => "Swap Stats", on_activate => sub { $conn->{stat_change_with} = $sw2->{value}; @@ -271,10 +368,10 @@ 0 }, ); - $table->add (2, 1, new CFPlus::UI::HBox children => [$sw1, $sw2]); + $table->add_at (2, 1, new CFPlus::UI::HBox children => [$sw1, $sw2]); # right: accept - $table->add (4, 0, new CFPlus::UI::Button + $table->add_at (4, 0, new CFPlus::UI::Button text => "Accept", on_activate => sub { $conn->send ("reply n"); @@ -347,13 +444,11 @@ $LOGIN_BUTTON->set_text ("Logout"); $SETUP_DIALOG->hide; - $PROFILE = $CFG->{profile}{default}; - 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 $mapsize, $mapsize; + $MAP = new CFPlus::Map; $CONN = eval { new CFPlus::Protocol @@ -364,7 +459,7 @@ mapw => $mapsize, maph => $mapsize, - client => "cfplus $VERSION $] $^O", + client => "cfplus $CFPlus::VERSION $] $^O", map_widget => $MAPWIDGET, logview => $LOGVIEW, @@ -373,6 +468,10 @@ mapmap => $MAPMAP, query => \&server_query, + setup_req => { + smoothing => $CFG->{map_smoothing}*1, + }, + sound_play => sub { my ($x, $y, $soundnum, $type) = @_; @@ -401,7 +500,10 @@ $SETUP_NOTEBOOK->set_current_page ($SETUP_SERVER); $SETUP_DIALOG->show; $PL_WINDOW->hide; - $SPELL_PAGE->clear_spells; + $SPELL_LIST->clear_spells; + $CFPlus::UI::ROOT->emit (stop_game => ! ! $CONN); + + &audio_music_set ([]); return unless $CONN; @@ -412,7 +514,6 @@ $CONN = 0; # false, does not autovivify undef $MAP; - undef $PROFILE; } sub graphics_setup { @@ -420,85 +521,105 @@ $vbox->add (my $table = new CFPlus::UI::Table expand => 1, col_expand => [0, 1]); - $table->add (0, 0, new CFPlus::UI::Label valign => 0, align => 1, text => "Video Mode"); - $table->add (1, 0, my $hbox = new CFPlus::UI::HBox); + my $row = 0; - $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"); + $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", @{$SDL_MODES[$value]}); + $mode_label->set_text (sprintf '%dx%d@%d+%d', @{$SDL_MODES[$value]}); }); $mode_slider->emit (changed => $mode_slider->{range}[0]); - my $row = 1; - - $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fullscreen"); - $table->add (1, $row++, $FULLSCREEN_ENABLE = new CFPlus::UI::CheckBox + $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 (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fast & Ugly"); - $table->add (1, $row++, new CFPlus::UI::CheckBox + $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 (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Scale"); - $table->add (1, $row++, new CFPlus::UI::Slider + $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 (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Fog of War"); - $table->add (1, $row++, new CFPlus::UI::CheckBox + $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 (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "FoW Intensity"); - $table->add (1, $row++, new CFPlus::UI::Slider + $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 (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 + $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 { $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 + $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 { @@ -508,8 +629,8 @@ } ); - $table->add (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Gauge size"); - $table->add (1, $row++, new CFPlus::UI::Slider + $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 { @@ -519,16 +640,6 @@ } ); - $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 } @@ -539,18 +650,18 @@ 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 + $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 (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 { +# $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 (0, $row, new CFPlus::UI::Label valign => 0, align => 1, text => "Background Music"); - $table->add (1, $row++, my $hbox = new CFPlus::UI::HBox); + $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.", @@ -562,7 +673,7 @@ on_changed => sub { $CFG->{bgm_volume} = $_[1]; CFPlus::MixMusic::volume $_[1] * 128; 0 } ); - $table->add (1, $row++, new CFPlus::UI::Button + $table->add_at (1, $row++, new CFPlus::UI::Button expand => 1, align => 0, text => "Apply", tooltip => "Apply the audio settings", on_activate => sub { @@ -631,27 +742,17 @@ 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 }); - - 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_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 } @@ -709,10 +810,10 @@ ) { my ($col, $row, $id, $label, $template) = @$_; - $tbl->add ($col , $row, $STATWIDS->{$id} = new CFPlus::UI::Label + $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 ($col + 1, $row, $STATWIDS->{"$id\_lbl"} = new CFPlus::UI::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"); } @@ -763,11 +864,12 @@ 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, + $tbl2->add_at ($col, $row, $STATWIDS->{"res_$_"} = new CFPlus::UI::Label font => $FONT_FIXED, @@ -778,14 +880,14 @@ can_hover => 1, tooltip => $resist_names{$_}->[1], ); - $tbl2->add ($col + 1, $row, new CFPlus::UI::Image + $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 ($col + 2, $row, new CFPlus::UI::Label + $tbl2->add_at ($col + 2, $row, new CFPlus::UI::Label text => $resist_names{$_}->[0], font => $FONT_FIXED, can_hover => 1, @@ -828,29 +930,17 @@ 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 $buf; - - my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0; - - unless ($fh) { - $label->set_text ("unable to contact metaserver: $!"); - return; - } + $table->add_at (0, 0, my $label = new CFPlus::UI::Label max_w => $WIDTH * 0.8, text => "fetching server list..."); - Event->io (fd => $fh, poll => 'r', cb => sub { - my $res = sysread $fh, $buf, 8192, length $buf; + my $ok = 0; - if (!defined $res) { - $_[0]->w->cancel; - $label->set_text ("error while retrieving server list: $!"); - } elsif ($res == 0) { - $_[0]->w->cancel; - status "server list retrieved"; - - utf8::decode $buf if utf8::valid $buf; + 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 = ( @@ -861,7 +951,7 @@ "Short information about this server provided by its admins.", ); my @col = qw(#Users Host Uptime Version Description); - $table->add ($_, 0, new CFPlus::UI::Label + $table->add_at ($_, 0, new CFPlus::UI::Label can_hover => 1, can_events => 1, align => 0, fg => [1, 1, 0], text => $col[$_], tooltip => $tip[$_]) @@ -870,29 +960,30 @@ my @align = qw(1 0 1 1 -1); my $y = 0; - for my $m (sort { $b->[3] <=> $a->[3] } map [split /\|/], split /\015?\012/, $buf) { - my ($ip, $last, $host, $users, $version, $desc, $ibytes, $obytes, $uptime) = @$m; + 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; + s/&/&/g; + s/<//g; } $uptime = sprintf "%dd %02d:%02d:%02d", - (int $m->[8] / 86400), - (int $m->[8] / 3600) % 24, - (int $m->[8] / 60) % 60, - $m->[8] % 60; + (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 => [ + $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", @@ -905,18 +996,23 @@ (new CFPlus::UI::Empty expand => 1), ]); - $table->add ($_, $y, new CFPlus::UI::Label + $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 { @@ -930,7 +1026,8 @@ x => 'center', y => 'center', z => 3, - force_h => $::HEIGHT * 0.4, + force_w => $::WIDTH * 0.9, + force_h => $::HEIGHT * 0.7, child => $vbox, has_close_button => 1, table => $table, @@ -950,10 +1047,10 @@ 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_at (0, 2, new CFPlus::UI::Label valign => 0, align => 1, text => "Host:Port"); { - $table->add (1, 2, my $vbox = new CFPlus::UI::VBox); + $table->add_at (1, 2, my $vbox = new CFPlus::UI::VBox); $vbox->add ( $HOST_ENTRY = new CFPlus::UI::Entry @@ -977,23 +1074,23 @@ ); } - $table->add (0, 4, new CFPlus::UI::Label valign => 0, align => 1, text => "Username"); - $table->add (1, 4, new CFPlus::UI::Entry + $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 (0, 5, new CFPlus::UI::Label valign => 0, align => 1, text => "Password"); - $table->add (1, 5, new CFPlus::UI::Entry + $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 (0, 7, new CFPlus::UI::Label valign => 0, align => 1, text => "Map Size"); - $table->add (1, 7, new CFPlus::UI::Slider + $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. " @@ -1003,8 +1100,8 @@ 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 + $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. " @@ -1016,21 +1113,30 @@ on_changed => sub { $CFG->{face_prefetch} = $_[1]; 0 }, ); - $table->add (0, 9, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Count"); - $table->add (1, 9, new CFPlus::UI::Entry + $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 (0, 10, new CFPlus::UI::Label valign => 0, align => 1, text => "Output-Sync"); - $table->add (1, 10, new CFPlus::UI::Entry + $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 (1, 11, $LOGIN_BUTTON = new CFPlus::UI::Button + $table->add_at (1, 12, $LOGIN_BUTTON = new CFPlus::UI::Button expand => 1, align => 0, text => "Login", @@ -1041,12 +1147,25 @@ }, ); - $table->add (0, 12, new CFPlus::UI::Label valign => 0, align => 1, text => "Chat Command"); - $table->add (1, 12, my $saycmd = new CFPlus::UI::Entry + $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 => "Chat Command"); + $table->add_at (1, $row++, 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.", + . "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; @@ -1054,23 +1173,31 @@ } ); - $table->add (0, 13, new CFPlus::UI::Label valign => 0, align => 1, text => "Tip of the day"); - $table->add (1, 13, my $saycmd = new CFPlus::UI::CheckBox + $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->{shop_tips} = $value; + $CFG->{show_tips} = $value; 0 } ); - $vbox->add (new CFPlus::UI::FancyFrame - label => "Server Info", - child => ($SERVER_INFO = new CFPlus::UI::Label ellipsise => 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) = @_; + $LOGVIEW->{max_par} = $CFG->{logview_max_par} = $value*1; + 0 + }, ); - $vbox + $table } sub message_window { @@ -1137,7 +1264,14 @@ } sub autopickup_setup { - my $table = new CFPlus::UI::Table; + 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, @@ -1161,12 +1295,12 @@ ["Cloaks" => PICKUP_CLOAK], ], - ["Readables", 2, 2, + ["Readables", 2, 0, ["Spellbooks" => PICKUP_SPELLBOOK], ["Skillscrolls" => PICKUP_SKILLSCROLL], ["Normal Books/Scrolls" => PICKUP_READABLES], ], - ["Misc", 2, 7, + ["Misc", 2, 5, ["Food" => PICKUP_FOOD], ["Drinks" => PICKUP_DRINK], ["Valuables (Money, Gems)" => PICKUP_VALUABLES], @@ -1176,19 +1310,20 @@ ["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]); + $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 ($x , $y, new CFPlus::UI::Label text => $_->[0], align => 1, expand => 1); - $table->add ($x+1, $y, my $checkbox = new CFPlus::UI::CheckBox + $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) = @_; @@ -1209,7 +1344,7 @@ } } - $table->add (2, 18, new CFPlus::UI::ValSlider + $table->add_at (2, 18, new CFPlus::UI::ValSlider range => [$::CFG->{pickup} & 0xF, 0, 16, 1, 1], template => ">= 99", to_value => sub { ">= " . 5 * $_[0] }, @@ -1222,7 +1357,7 @@ 1; }); - $table->add (3, 18, new CFPlus::UI::Button + $table->add_at (3, 18, new CFPlus::UI::Button text => "set", on_activate => sub { $::CONN->send_command ("pickup $::CFG->{pickup}") @@ -1230,16 +1365,22 @@ 0 }); - $table + $r } my %SORT_ORDER = ( type => undef, - mtime => sub { sort { - ($a->{flags} & F_LOCKED) <=> ($b->{flags} & F_LOCKED) - or $b->{mtime} <=> $a->{mtime} - or $a->{type} <=> $b->{type} - } @_ }, + 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} @@ -1274,6 +1415,7 @@ $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); @@ -1312,7 +1454,7 @@ my $ntb = $PL_NOTEBOOK = - new CFPlus::UI::Notebook expand => 1, debug => 1; + new CFPlus::UI::Notebook expand => 1; $ntb->add ( "Statistics (F2)" => $STATS_PAGE = stats_window, @@ -1323,8 +1465,8 @@ "Shows all your Skills." ); - my $spellsw = new CFPlus::UI::ScrolledWindow (expand => 1, scroll_y => 1); - $spellsw->add ($SPELL_PAGE = new CFPlus::UI::SpellList); + 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." @@ -1334,6 +1476,8 @@ "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 (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); @@ -1341,123 +1485,8 @@ $plwin } -sub update_bindings { - $BIND_UPD_CB->() if $BIND_UPD_CB; -} - sub keyboard_setup { - my $binding_list = new CFPlus::UI::VBox; - - my $refresh; - $refresh = $BIND_UPD_CB = sub { - $binding_list->clear (); - - return unless $PROFILE; - - for my $mod (keys %{$PROFILE->{bindings}}) { - for my $sym (keys %{$PROFILE->{bindings}{$mod}}) { - my $cmds = $PROFILE->{bindings}{$mod}{$sym}; - next unless ref $cmds eq 'ARRAY' and @$cmds > 0; - - my $lbl = join "; ", @$cmds; - my $nam = CFPlus::BindingEditor::keycombo_to_name ($mod, $sym); - $binding_list->add (my $hb = new CFPlus::UI::HBox); - $hb->add (new CFPlus::UI::Button - text => "delete", - tooltip => "Deletes the binding", - on_activate => sub { - $binding_list->remove ($hb); - delete $PROFILE->{bindings}{$mod}{$sym}; - 0 - }); - - $hb->add (new CFPlus::UI::Button - text => "edit", - tooltip => "Edits the binding", - on_activate => sub { - $::BIND_EDITOR->set_binding ( - $mod, $sym, $PROFILE->{bindings}{$mod}{$sym}, - sub { - my ($nmod, $nsym, $ncmds) = @_; - $::BIND_EDITOR->cfg_unbind ($mod, $sym); - $::BIND_EDITOR->cfg_bind ($nmod, $nsym, $ncmds); - $refresh->(); - $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD); - $SETUP_DIALOG->show; - }, - sub { - $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD); - $SETUP_DIALOG->show; - }); - $::BIND_EDITOR->show; - $SETUP_DIALOG->hide; - 0 - }); - - $hb->add (new CFPlus::UI::Label text => "(Key: $nam)"); - $hb->add (new CFPlus::UI::Label text => $lbl, expand => 1); - } - } - }; - - my $vb = new CFPlus::UI::VBox; - $vb->add (new CFPlus::UI::FancyFrame - label => "Options", - child => (my $hb = new CFPlus::UI::HBox), - ); - $hb->add (new CFPlus::UI::Label text => "only shift-up stops fire"); - $hb->add (new CFPlus::UI::CheckBox - expand => 1, - state => $CFG->{shift_fire_stop}, - tooltip => "If this checkbox is enabled you will stop fire only if you stop pressing shift", - on_changed => sub { - my ($cbox, $value) = @_; - $CFG->{shift_fire_stop} = $value; - 0 - }); - - $vb->add (new CFPlus::UI::FancyFrame - label => "Bindings", - child => $binding_list); - $vb->add (my $hb = new CFPlus::UI::HBox); - - $hb->add (new CFPlus::UI::Button - text => "record new", - expand => 1, - tooltip => "This button opens the binding editor with an empty binding.", - on_activate => sub { - $::BIND_EDITOR->set_binding (undef, undef, [], - sub { - my ($mod, $sym, $cmds) = @_; - $::BIND_EDITOR->cfg_bind ($mod, $sym, $cmds); - $refresh->(); - $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD); - $SETUP_DIALOG->show; - }, - sub { - $SETUP_NOTEBOOK->set_current_page ($SETUP_KEYBOARD); - $SETUP_DIALOG->show; - }, - ); - $SETUP_DIALOG->hide; - $::BIND_EDITOR->show; - 0 - }, - ); - - $hb->add (new CFPlus::UI::Button - text => "close", - tooltip => "Closes the binding window", - expand => 1, - on_activate => sub { - $SETUP_DIALOG->hide; - 0 - } - ); - - $refresh->(); - - $vb + CFPlus::Macro::keyboard_setup } sub help_window { @@ -1624,52 +1653,54 @@ # 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); + 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, + ; - $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, - ); + $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 (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; - }, - ); + $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; + $dialog->show; + }; } sub sdl_init { @@ -1678,17 +1709,15 @@ } 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}] }; + ($WIDTH, $HEIGHT, my ($rgb, $alpha)) = @{ $SDL_MODES[$CFG->{sdl_mode}] }; $FULLSCREEN = $CFG->{fullscreen}; $FAST = $CFG->{fast}; - CFPlus::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN + CFPlus::SDL_SetVideoMode $WIDTH, $HEIGHT, $rgb, $alpha, $FULLSCREEN or die "SDL_SetVideoMode failed: " . (CFPlus::SDL_GetError) . "\n"; $SDL_ACTIVE = 1; @@ -1714,8 +1743,6 @@ force_y => 0; $DEBUG_STATUS->show; - $BIND_EDITOR = new CFPlus::BindingEditor (x => "max", y => 0); - $STATUSBOX = new CFPlus::UI::Statusbox; $STATUSBOX->add ("Use Alt-Enter to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]); @@ -1761,7 +1788,8 @@ indent => -4, can_hover => 1, can_events => 1, - tooltip => "Server Log. This text viewer contains all the messages sent by the server.", + max_par => $CFG->{logview_max_par}, + tooltip => "Server Log. This text viewer contains all recent messages sent by the server.", ; $SETUP_DIALOG = new CFPlus::UI::Toplevel @@ -1782,8 +1810,8 @@ $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 (Client => client_setup, + "Configure various client-specific settings."); $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, @@ -1825,6 +1853,7 @@ $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", @@ -1845,29 +1874,214 @@ $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_at (0, $row, new CFPlus::UI::Label text => "Name:"); + $table->add_at (1, $row++, new CFPlus::UI::Entry expand => 1, on_changed => sub { $::IN_BUILD_MODE->{name} = $_[1]; 0 }); + } + if ($info->{has_text}) { + $table->add_at (0, $row, new CFPlus::UI::Label text => "Text:"); + $table->add_at (1, $row++, new CFPlus::UI::Entry expand => 1, on_changed => sub { $::IN_BUILD_MODE->{text} = $_[1]; 0 }); + } + if ($info->{has_connection}) { + $table->add_at (0, $row, new CFPlus::UI::Label text => "Connection ID:"); + $table->add_at (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 { +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 { + # 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}; - # TODO: hack, do play loop and mood music - $bgmusic = new_from_file CFPlus::MixMusic CFPlus::find_rcfile "music/$bgmusic[0]"; - $bgmusic->play (0); + # 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]; - push @bgmusic, shift @bgmusic; + audio_music_start; + } +} + +sub audio_music_finished { + $MUSIC_PLAYING = undef; + undef $MUSIC_PLAYER; + + audio_music_changed; } sub audio_init { @@ -1885,6 +2099,7 @@ audio_music_finished; + local $_; while (<$fh>) { next if /^\s*#/; next if /^\s*$/; @@ -1926,7 +2141,7 @@ $CFPlus::UI::ROOT->draw; $WANT_REFRESH = 0; - $CAN_REFRESH = 0; + $CAN_REFRESH = 0; $LAST_REFRESH = $NOW; CFPlus::SDL_GL_SwapBuffers; @@ -1936,11 +2151,11 @@ $NOW = time; ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_) - for CFPlus::SDL_PollEvent; + for CFPlus::poll_events; if (%animate_object) { $_->animate ($LAST_REFRESH - $NOW) for values %animate_object; - $WANT_REFRESH++; + ++$WANT_REFRESH; } if ($WANT_REFRESH) { @@ -1971,7 +2186,7 @@ %SDL_CB = ( CFPlus::SDL_QUIT => sub { - Event::unloop -1; + exit; }, CFPlus::SDL_VIDEORESIZE => sub { }, @@ -1979,7 +2194,12 @@ CFPlus::UI::full_refresh; }, CFPlus::SDL_ACTIVEEVENT => sub { -# printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d# +# 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) { @@ -2010,35 +2230,39 @@ { 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.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 => 'say', - audio_enable => 1, - bgm_enable => 1, - bgm_volume => 0.25, - face_prefetch => 0, - output_sync => 1, - output_count => 1, - pickup => 0, - inv_sort => "mtime", - default => "profile", # default profile - show_tips => 1, + 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, + 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, + logview_max_par => 1000, ); while (my ($k, $v) = each %DEF_CFG) { @@ -2046,15 +2270,28 @@ } $CFG->{profile}{default}{host} ||= "crossfire.schmorp.de"; + $PROFILE = $CFG->{profile}{default}; - sdl_init; + # 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_MODES = reverse - grep $_->[0] >= 640 && $_->[1] >= 480, - CFPlus::SDL_ListModes; + 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; { @@ -2092,19 +2329,22 @@ # warn $t2-$t1; # } + $startup_done->(); + video_init; audio_init; } show_tip_of_the_day if $CFG->{show_tips}; -use Data::Dumper; warn Dumper [CFPlus::win32_proxy_info()];#d# - Event::loop; #CFPlus::SDL_Quit; #CFPlus::_exit 0; -END { CFPlus::SDL_Quit } +END { + CFPlus::SDL_Quit; + CFPlus::DB::Server::stop; +} =head1 NAME