#!/opt/bin/perl use strict; use utf8; 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"; } } unshift @INC, $ENV{PAR_TEMP}; if ($^O eq "MSWin32") { $ENV{GTK_RC_FILES} = "$ENV{PAR_TEMP}/share/themes/MS-Windows/gtk-2.0/gtkrc"; } } } # need to do it again because that pile of garbage called PAR nukes it before main unshift @INC, $ENV{PAR_TEMP}; use Time::HiRes 'time'; use Event; use Crossfire; use Crossfire::Protocol; use Compress::LZF; use CFClient; use CFClient::UI; use CFClient::MapWidget; $Event::DIED = sub { CFClient::error $_[1]; }; #$SIG{__WARN__} = sub { Carp::cluck $_[0] };#d# our $VERSION = '0.1'; my $MAX_FPS = 60; my $MIN_FPS = 5; # unused as of yet our $META_SERVER = "crossfire.real-time.com:13326"; our $FACEMAP; our $TILECACHE; our $MAPCACHE; our $LAST_REFRESH; our $NOW; our $CFG; our $CONN; our $FAST; # fast, low-quality mode, possibly useful for software-rendering our @SDL_MODES; our $WIDTH; our $HEIGHT; our $FULLSCREEN; our $FONTSIZE; our $FONT_PROP; our $FONT_FIXED; our $MAP; our $MAPWIDGET; our $BUTTONBAR; our $LOGVIEW; our $CONSOLE; our $METASERVER; 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 $STATUS_LINE; our $DEBUG_STATUS; sub status { $STATUS_LINE->set_text ($_[0]); $STATUS_LINE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h} - $STATUS_LINE->{h}); } sub debug { $DEBUG_STATUS->set_text ($_[0]); $DEBUG_STATUS->move ($WIDTH - $DEBUG_STATUS->{w}, 0, $DEBUG_STATUS->{w}, $DEBUG_STATUS->{h}); } sub start_game { status "logging in..."; my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32; $MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}"; $MAP = new CFClient::Map $mapsize, $mapsize; my ($host, $port) = split /:/, $CFG->{host}; $CONN = new conn host => $host, port => $port || 13327, user => $CFG->{user}, pass => $CFG->{password}, mapw => $mapsize, maph => $mapsize, ; status "login successful"; CFClient::lowdelay fileno $CONN->{fh}; } sub stop_game { undef $CONN; } sub client_setup { my $dialog = new CFClient::UI::FancyFrame title => "Client Setup", child => (my $vbox = new CFClient::UI::VBox); $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]); $table->add (0, 0, new CFClient::UI::Label valign => 0, align => 1, text => "Video Mode"); $table->add (1, 0, my $hbox = new CFClient::UI::HBox); $hbox->add (my $mode_slider = new CFClient::UI::Slider expand => 1, req_w => 100, range => [$CFG->{sdl_mode}, 0, scalar @SDL_MODES, 1]); $hbox->add (my $mode_label = new CFClient::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]); my $row = 1; $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen"); $table->add (1, $row++, new CFClient::UI::CheckBox state => $CFG->{fullscreen}, tooltip => "Bring the client into fullscreen mode", connect_changed => sub { my ($self, $value) = @_; $CFG->{fullscreen} = $value; } ); $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly"); $table->add (1, $row++, new CFClient::UI::CheckBox state => $CFG->{fast}, tooltip => "Lower the visual quality considerably to speed up rendering.", connect_changed => sub { my ($self, $value) = @_; $CFG->{fast} = $value; } ); $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Map Scale"); $table->add (1, $row++, new CFClient::UI::Slider range => [$CFG->{map_scale}, 0.25, 2, 0.05], tooltip => "Enlarge or shrink the displayed map", connect_changed => sub { my ($self, $value) = @_; $CFG->{map_scale} = 0.05 * int $value / 0.05; } ); $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War"); $table->add (1, $row++, new CFClient::UI::CheckBox state => $CFG->{fow_enable}, tooltip => "Fog-of-War marks areas that cannot be seen by the player", connect_changed => sub { my ($self, $value) = @_; $CFG->{fow_enable} = $value; } ); $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity"); $table->add (1, $row++, new CFClient::UI::Slider range => [$CFG->{fow_intensity}, 0, 1 + 0.001, 0.001], tooltip => "The higher the intensity, the lighter the Fog-of-War color", connect_changed => sub { my ($self, $value) = @_; $CFG->{fow_intensity} = $value; } ); $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth"); $table->add (1, $row++, new CFClient::UI::CheckBox state => $CFG->{fow_smooth}, tooltip => "Smooth the Fog-of-War a bit to make it more realistic", connect_changed => sub { my ($self, $value) = @_; $CFG->{fow_smooth} = $value; status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::GL_VERSION < 1.2; } ); $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize"); $table->add (1, $row++, new CFClient::UI::Slider range => [$CFG->{gui_fontsize}, 0.5, 2, 0.1], tooltip => "The font size used by most GUI elements", connect_changed => sub { $CFG->{gui_fontsize} = 0.1 * int $_[1] * 10; # $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize}; } ); $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Server Log Fontsize"); $table->add (1, $row++, new CFClient::UI::Slider range => [$CFG->{log_fontsize}, 0.5, 2, 0.1], tooltip => "The font size used by the server log window only", connect_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = 0.1 * int $_[1] * 10); } ); $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize"); $table->add (1, $row++, new CFClient::UI::Slider range => [$CFG->{stat_fontsize}, 0.5, 2, 0.1], tooltip => "The font size used by the statistics window only", connect_changed => sub { $CFG->{stat_fontsize} = 0.1 * int $_[1] * 10; &set_stats_window_fontsize; } ); $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge size"); $table->add (1, $row++, new CFClient::UI::Slider range => [$CFG->{gauge_size}, 0.2, 0.8, 0.02], tooltip => "Adjust the size of the stats gauges at the bottom right", connect_changed => sub { $CFG->{gauge_size} = $_[1]; my $h = int $HEIGHT * $CFG->{gauge_size}; $GAUGES->{win}->set_size ($WIDTH, $h); $GAUGES->{win}->move (0, $HEIGHT - $h); } ); $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge fontsize"); $table->add (1, $row++, new CFClient::UI::Slider range => [$CFG->{gauge_fontsize}, 0.5, 2.0, 0.1], tooltip => "Adjusts the fontsize of the gauges at the bottom right", connect_changed => sub { $CFG->{gauge_fontsize} = 0.1 * int $_[1] * 10; &set_gauge_window_fontsize; } ); $table->add (1, $row++, new CFClient::UI::Button expand => 1, align => 0, text => "Apply", tooltip => "Apply the video settings", connect_activate => sub { video_shutdown (); video_init (); } ); $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable"); $table->add (1, $row++, new CFClient::UI::CheckBox state => $CFG->{audio_enable}, tooltip => "If enabled, sound effects and music will be played. If disabled, no audio will be used and the soundcard will not be opened.", connect_changed => sub { $CFG->{audio_enable} = $_[1]; } ); # $table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Effects Volume"); # $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], connect_changed => sub { # $CFG->{effects_volume} = $_[1]; # }); $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music"); $table->add (1, $row++, my $hbox = new CFClient::UI::HBox); $hbox->add (new CFClient::UI::CheckBox expand => 1, state => $CFG->{bgm_enable}, tooltip => "Enable background music playing", connect_changed => sub { $CFG->{bgm_enable} = $_[1]; } ); $hbox->add (new CFClient::UI::Slider expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0.1], tooltip => "The volume of the background music", connect_changed => sub { $CFG->{bgm_volume} = $_[1]; CFClient::MixMusic::volume $_[1] * 128; } ); $table->add (1, $row++, new CFClient::UI::Button expand => 1, align => 0, text => "Apply", tooltip => "Apply the audio settings", connect_activate => sub { audio_shutdown (); audio_init (); } ); $dialog } sub set_stats_window_fontsize { for (values %{$STATWIDS}) { $_->set_fontsize ($::CFG->{stat_fontsize}); } } sub set_gauge_window_fontsize { for (map { $GAUGES->{$_} } grep { $_ ne 'win' } keys %{$GAUGES}) { $_->set_fontsize ($::CFG->{gauge_fontsize}); } # local $GAUGES->{win}{parent};#d# # use PApp::Util; open D, ">:utf8", "d"; print D PApp::Util::dumpval $GAUGES->{win}; close D; } sub make_gauge_window { my $gh = int ($HEIGHT * $CFG->{gauge_size}); # my $gw = int ($WIDTH * $CFG->{gauge_w_size}); my $win = new CFClient::UI::Frame ( y => $HEIGHT - $gh, x => 0, user_w => $WIDTH, user_h => $gh ); $win->add (my $hbox = new CFClient::UI::HBox children => [ (new CFClient::UI::HBox expand => 1), ($FLOORBOX = new CFClient::UI::VBox), (my $vbox = new CFClient::UI::VBox), ], ); $vbox->add (new CFClient::UI::HBox expand => 1, children => [ (new CFClient::UI::Empty expand => 1), (my $hb = new CFClient::UI::HBox), ], ); $hb->add (my $hg = new CFClient::UI::Gauge type => 'hp', tooltip => "Health points - depletes when you get wounded, refills when you heal or idle"); $hb->add (my $mg = new CFClient::UI::Gauge type => 'mana', tooltip => "Spell points - deplete when you cast wizard spells, refills when you idle"); $hb->add (my $gg = new CFClient::UI::Gauge type => 'grace', tooltip => "Grace points - deplete when you cast priest spells, refills when you pray"); $hb->add (my $fg = new CFClient::UI::Gauge type => 'food', tooltip => "Food - depletes with time, faster when you heal or build mana, refills when you eat healthy food"); $vbox->add (my $exp = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1, tooltip => "Experience points and level - increases when you kill monsters or successfully use skills"); $vbox->add (my $rng = new CFClient::UI::Label valign => 0, align => 1, can_hover => 1, can_events => 1, tooltip => "Ranged attack - how you attack when you press shift-cursor (spell, skill, weapon etc.)"); $GAUGES = { exp => $exp, win => $win, range => $rng, food => $fg, mana => $mg, hp => $hg, grace => $gg }; &set_gauge_window_fontsize; $win } sub make_stats_window { my $tgw = new CFClient::UI::FancyFrame (x => $WIDTH * 2/5, y => 0, title => "Stats"); $tgw->add (my $vb = new CFClient::UI::VBox); $vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1); $vb->add ($STATWIDS->{map} = new CFClient::UI::Label valign => 0, align => -1, text => "Map:", expand => 1); $vb->add (my $hb = new CFClient::UI::HBox expand => 1); $hb->add (my $tbl = new CFClient::UI::Table expand => 1); my $black = [0, 0, 0]; $tbl->add (0, 0, $STATWIDS->{st_str} = new CFClient::UI::Label valign => 0, align => +1, template => "30"); $tbl->add (0, 1, $STATWIDS->{st_dex} = new CFClient::UI::Label valign => 0, align => +1, template => "30"); $tbl->add (0, 2, $STATWIDS->{st_con} = new CFClient::UI::Label valign => 0, align => +1, template => "30"); $tbl->add (0, 3, $STATWIDS->{st_int} = new CFClient::UI::Label valign => 0, align => +1, template => "30"); $tbl->add (0, 4, $STATWIDS->{st_wis} = new CFClient::UI::Label valign => 0, align => +1, template => "30"); $tbl->add (0, 5, $STATWIDS->{st_pow} = new CFClient::UI::Label valign => 0, align => +1, template => "30"); $tbl->add (0, 6, $STATWIDS->{st_cha} = new CFClient::UI::Label valign => 0, align => +1, template => "30"); $tbl->add (1, 0, $STATWIDS->{st_str_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Str"); $tbl->add (1, 1, $STATWIDS->{st_dex_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Dex"); $tbl->add (1, 2, $STATWIDS->{st_con_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Con"); $tbl->add (1, 3, $STATWIDS->{st_int_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Int"); $tbl->add (1, 4, $STATWIDS->{st_wis_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Wis"); $tbl->add (1, 5, $STATWIDS->{st_pow_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Pow"); $tbl->add (1, 6, $STATWIDS->{st_cha_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Cha"); $tbl->add (2, 0, $STATWIDS->{st_wc} = new CFClient::UI::Label valign => 0, align => +1, template => "-120"); $tbl->add (2, 1, $STATWIDS->{st_ac} = new CFClient::UI::Label valign => 0, align => +1, template => "-120"); $tbl->add (2, 2, $STATWIDS->{st_dam} = new CFClient::UI::Label valign => 0, align => +1, template => "120"); $tbl->add (2, 3, $STATWIDS->{st_arm} = new CFClient::UI::Label valign => 0, align => +1, template => "120"); $tbl->add (2, 4, $STATWIDS->{st_spd} = new CFClient::UI::Label valign => 0, align => +1, template => "10.54"); $tbl->add (2, 5, $STATWIDS->{st_wspd} = new CFClient::UI::Label valign => 0, align => +1, template => "9"); $tbl->add (3, 0, $STATWIDS->{st_wc_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Wc"); $tbl->add (3, 1, $STATWIDS->{st_ac_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Ac"); $tbl->add (3, 2, $STATWIDS->{st_dam_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Dam"); $tbl->add (3, 3, $STATWIDS->{st_arm_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Arm"); $tbl->add (3, 4, $STATWIDS->{st_spd_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "Sp"); $tbl->add (3, 5, $STATWIDS->{st_wspd_lbl} = new CFClient::UI::Label fg => $black, valign => 0, align => -1, text => "WSp"); $hb->add (my $tbl2 = new CFClient::UI::Table expand => 1); my $row = 0; my $col = 0; my %resist_names = ( slow => "Slow", holyw => "Holy Word", conf => "Confusion", fire => "Fire", depl => "Depletion", magic => "Magic", drain => "Draining", acid => "Acid", pois => "Poison", para => "Paralysation", deat => "Death", phys => "Physical", blind => "Blind", fear => "Fear", tund => "Turn undead", elec => "Electricity", cold => "Cold", ghit => "Ghost hit", ); 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 CFClient::UI::Label template => "-100%", align => +1, valign => 0, tooltip => $resist_names{$_} ); $tbl2->add ($col + 1, $row, new CFClient::UI::Image can_hover => 1, can_events => 1, image => "ui/resist/resist_$_.png", tooltip => $resist_names{$_} ); $row++; if ($row % 6 == 0) { $col += 2; $row = 0; } } &set_stats_window_fontsize; update_stats_window ({}); $tgw } sub formsep { reverse join ",", grep length, split /(...)/, reverse $_[0] * 1 } sub update_stats_window { my ($stats) = @_; # i love text protocols!!! my $hp = $stats->{Crossfire::Protocol::CS_STAT_HP} * 1; my $hp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXHP} * 1; my $sp = $stats->{Crossfire::Protocol::CS_STAT_SP} * 1; my $sp_m = $stats->{Crossfire::Protocol::CS_STAT_MAXSP} * 1; my $fo = $stats->{Crossfire::Protocol::CS_STAT_FOOD} * 1; my $fo_m = 999; my $gr = $stats->{Crossfire::Protocol::CS_STAT_GRACE} * 1; my $gr_m = $stats->{Crossfire::Protocol::CS_STAT_MAXGRACE} * 1; $GAUGES->{hp} ->set_value ($hp, $hp_m); $GAUGES->{mana} ->set_value ($sp, $sp_m); $GAUGES->{food} ->set_value ($fo, $fo_m); $GAUGES->{grace} ->set_value ($gr, $gr_m); $GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{Crossfire::Protocol::CS_STAT_EXP64}) . " (lvl " . ($stats->{Crossfire::Protocol::CS_STAT_LEVEL} * 1) . ")"); my $rng = $stats->{Crossfire::Protocol::CS_STAT_RANGE}; $rng =~ s/^Range: //; # thank you so much dear server $GAUGES->{range} ->set_text ("Rng: " . $rng); my $title = $stats->{Crossfire::Protocol::CS_STAT_TITLE}; $title =~ s/^Player: //; $STATWIDS->{title} ->set_text ("Title: " . $title); $STATWIDS->{st_str} ->set_text (sprintf "%d", $stats->{5}); $STATWIDS->{st_dex} ->set_text (sprintf "%d", $stats->{8}); $STATWIDS->{st_con} ->set_text (sprintf "%d", $stats->{9}); $STATWIDS->{st_int} ->set_text (sprintf "%d", $stats->{6}); $STATWIDS->{st_wis} ->set_text (sprintf "%d", $stats->{7}); $STATWIDS->{st_pow} ->set_text (sprintf "%d", $stats->{22}); $STATWIDS->{st_cha} ->set_text (sprintf "%d", $stats->{10}); $STATWIDS->{st_wc} ->set_text (sprintf "%d", $stats->{13}); $STATWIDS->{st_ac} ->set_text (sprintf "%d", $stats->{14}); $STATWIDS->{st_dam} ->set_text (sprintf "%d", $stats->{15}); $STATWIDS->{st_arm} ->set_text (sprintf "%d", $stats->{16}); $STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_SPEED}); $STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{Crossfire::Protocol::CS_STAT_WEAP_SP}); my %tbl = ( phys => 100, magic => 101, fire => 102, elec => 103, cold => 104, conf => 105, acid => 106, drain => 107, ghit => 108, pois => 109, slow => 110, para => 111, tund => 112, fear => 113, depl => 113, deat => 115, holyw => 116, blind => 117 ); for (keys %tbl) { $STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}}); } } sub metaserver_dialog { my $dialog = new CFClient::UI::FancyFrame title => "Metaserver", child => (my $vbox = new CFClient::UI::VBox); $vbox->add ($dialog->{table} = new CFClient::UI::Table); $dialog } sub update_metaserver { my ($HOST) = @_; my $table = $METASERVER->{table}; $table->clear; $table->add (0, 0, my $label = new CFClient::UI::Label max_w => $WIDTH * 0.8, text => "fetching metaserver list..."); my $buf; my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0; unless ($fh) { $label->set_text ("unable to contact metaserver: $!"); return; } Event->io (fd => $fh, poll => 'r', cb => sub { my $res = sysread $fh, $buf, 8192, length $buf; 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; $table->clear; my @col = qw(Use #Users Host Uptime Version Description); $table->add ($_, 0, new CFClient::UI::Label align => 0, fg => [1, 1, 0], text => $col[$_]) for 0 .. $#col; 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 ($desc) { s/
/\n/gi; s/
  • /\n· /gi; s/<.*?>//sgi; 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; $m = [$users, $host, $uptime, $version, $desc]; $y++; $table->add (0, $y, new CFClient::UI::VBox children => [ (new CFClient::UI::Button text => "Use", connect_activate => sub { $HOST->set_text ($CFG->{host} = $host); }), (new CFClient::UI::Empty expand => 1), ]); $table->add ($_ + 1, $y, new CFClient::UI::Label align => $align[$_], text => $m->[$_], fontsize => 0.8) for 0 .. $#$m; } } }); } sub server_setup { my $dialog = new CFClient::UI::FancyFrame title => "Server Setup", child => (my $vbox = new CFClient::UI::VBox); $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]); $table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Host:Port"); { $table->add (1, 2, my $vbox = new CFClient::UI::VBox); $vbox->add ( my $HOST = new CFClient::UI::Entry expand => 1, text => $CFG->{host}, tooltip => "The hostname or ip address of the Crossfire(+) server to connect to", connect_changed => sub { my ($self, $value) = @_; $CFG->{host} = $value; } ); $METASERVER = metaserver_dialog; $vbox->add (new CFClient::UI::Flopper expand => 1, text => "Metaserver", other => $METASERVER, tooltip => "Show a list of avaible crossfire servers", connect_open => sub { update_metaserver $HOST; } ); } $table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "Username"); $table->add (1, 4, new CFClient::UI::Entry text => $CFG->{user}, tooltip => "The name of your character on the server", connect_changed => sub { my ($self, $value) = @_; $CFG->{user} = $value; } ); $table->add (0, 5, new CFClient::UI::Label valign => 0, align => 1, text => "Password"); $table->add (1, 5, new CFClient::UI::Entry text => $CFG->{password}, hidden => 1, tooltip => "The password for your character", connect_changed => sub { my ($self, $value) = @_; $CFG->{password} = $value; } ); $table->add (0, 6, new CFClient::UI::Label valign => 0, align => 1, text => "Def. say cmd"); $table->add (1, 6, my $saycmd = new CFClient::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. " ."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.", connect_changed => sub { my ($self, $value) = @_; $CFG->{say_command} = $value; } ); $table->add (0, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Map Size"); $table->add (1, 7, new CFClient::UI::Slider req_w => 100, range => [$CFG->{mapsize}, 10, 100 + 1, 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 for example.", connect_changed => sub { my ($self, $value) = @_; $CFG->{mapsize} = $self->{range}[0] = $value = int $value; }, ); $table->add (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Login", connect_activate => sub { start_game; }); $dialog } sub message_window { my $window = new CFClient::UI::FancyFrame title => "Messages", border_bg => [1, 1, 1, 0.5], bg => [0.3, 0.3, 0.3, 0.8], user_w => int $::WIDTH / 3, user_h => int $::HEIGHT / 5, child => (my $vbox = new CFClient::UI::VBox); $vbox->add ($LOGVIEW = new CFClient::UI::TextView expand => 1, font => $FONT_FIXED, fontsize => $::CFG->{log_fontsize}, ); $vbox->add (my $input = new CFClient::UI::Entry connect_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}; }, connect_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 } }, connect_escape => sub { $MAPWIDGET->focus_in }, ); $CONSOLE = { window => $window, input => $input }; $window } sub sdl_init { CFClient::SDL_Init and die "SDL::Init failed!\n"; } sub video_init { sdl_init; ($WIDTH, $HEIGHT) = @{ $SDL_MODES[$CFG->{sdl_mode}] }; $FULLSCREEN = $CFG->{fullscreen}; $FAST = $CFG->{fast}; CFClient::SDL_SetVideoMode $WIDTH, $HEIGHT, $FULLSCREEN or die "SDL_SetVideoMode failed!\n"; $SDL_ACTIVE = 1; $LAST_REFRESH = time - 0.01; CFClient::gl_init; $FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize}; ############################################################################# $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100; $DEBUG_STATUS->show; $STATUS_LINE = new CFClient::UI::Label padding => 0, y => $HEIGHT - $FONTSIZE * 1.8; $STATUS_LINE->show; $ALT_ENTER_MESSAGE = new CFClient::UI::Label padding => 0, fontsize => 0.8, markup => "Use Alt-Enter to toggle fullscreen mode"; $ALT_ENTER_MESSAGE->show; $ALT_ENTER_MESSAGE->move (0, $HEIGHT - $ALT_ENTER_MESSAGE->{h}); $CFClient::UI::ROOT->add ($MAPWIDGET = new CFClient::MapWidget); $MAPWIDGET->focus_in; $MAPWIDGET->connect (activate_console => sub { my ($mapwidget, $preset) = @_; if ($CONSOLE) { $CONSOLE->{input}->{auto_activated} = 1; $CONSOLE->{input}->focus_in; if ($preset && $CONSOLE->{input}->get_text eq '') { $CONSOLE->{input}->set_text ($preset); } } }); $CFClient::UI::ROOT->add ($BUTTONBAR = new CFClient::UI::HBox); $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup); $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup); $BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window); $CFClient::UI::ROOT->add (make_gauge_window); # 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 CFClient::UI::Flopper text => "Stats Window", other => make_stats_window); $BUTTONBAR->add (new CFClient::UI::Button text => "Save Config", connect_activate => sub { CFClient::write_cfg "$Crossfire::VARDIR/pclientrc"; status "Configuration Saved"; }); $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup } sub video_shutdown { $CFClient::UI::ROOT->{children} = []; undef $CFClient::UI::GRAB; undef $CFClient::UI::HOVER; 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_music_finished { return unless $CFG->{bgm_enable}; # TODO: hack, do play loop and mood music $bgmusic = new_from_file CFClient::MixMusic CFClient::find_rcfile "music/$bgmusic[0]"; $bgmusic->play (0); push @bgmusic, shift @bgmusic; } sub audio_init { if ($CFG->{audio_enable}) { if (open my $fh, "<:utf8", CFClient::find_rcfile "sounds/config") { $SDL_MIXER = !CFClient::Mix_OpenAudio; CFClient::Mix_AllocateChannels 8; CFClient::MixMusic::volume $CFG->{bgm_volume} * 128; audio_music_finished; 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 CFClient::MixChunk CFClient::find_rcfile "sounds/$file"; $chunk->volume ($volume * 128 / 100); $chunk }; } } else { status "unable to open sound config: $!"; } } } sub audio_shutdown { CFClient::Mix_CloseAudio if $SDL_MIXER; undef $SDL_MIXER; @SOUNDS = (); %AUDIO_CHUNKS = (); } my %animate_object; my $animate_timer; my $want_refresh; my $can_refresh; my $fps = 9; sub force_refresh { $fps = $fps * 0.95 + 1 / ($NOW - $LAST_REFRESH) * 0.05; debug sprintf "%3.2f", $fps; $want_refresh = 0; $can_refresh = 0; $CFClient::UI::ROOT->draw; CFClient::SDL_GL_SwapBuffers; $LAST_REFRESH = $NOW; } my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub { $NOW = time; ($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_) for CFClient::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 refresh { $want_refresh++; } sub animation_start { my ($widget) = @_; $animate_object{$widget} = $widget; } sub animation_stop { my ($widget) = @_; delete $animate_object{$widget}; } @conn::ISA = Crossfire::Protocol::; sub conn::stats_update { my ($self, $stats) = @_; update_stats_window ($stats); } sub conn::user_send { my ($self, $command) = @_; $self->send_command ($command); status $command; } sub conn::map_scroll { my ($self, $dx, $dy) = @_; $MAP->scroll ($dx, $dy); } sub conn::feed_map1a { my ($self, $data) = @_; # $self->Crossfire::Protocol::feed_map1a ($data); $MAP->map1a_update ($data); $MAPWIDGET->update; } sub conn::flush_map { my ($self) = @_; my $map_info = delete $self->{map_info} or return; my ($hash, $x, $y, $w, $h) = @$map_info; my $data = $MAP->get_rect ($x, $y, $w, $h); $MAPCACHE->put ($hash => Compress::LZF::compress $data); #warn sprintf "SAVEmap[%s] length %d\n", $hash, length $data;#d# } sub conn::map_clear { my ($self) = @_; $self->flush_map; delete $self->{neigh_map}; $MAP->clear; } sub conn::load_map($$$) { my ($self, $hash, $x, $y) = @_; if (defined (my $data = $MAPCACHE->get ($hash))) { $data = Compress::LZF::decompress $data; #warn sprintf "LOADmap[%s,%d,%d] length %d\n", $hash, $x, $y, length $data;#d# for my $id ($MAP->set_rect ($x, $y, $data)) { my $data = $TILECACHE->get ($id) or next; $self->set_texture ($id => $data); } } } # this method does a "flood fill" into every tile direction # it assumes that tiles are arranged in a rectangular grid, # i.e. a map is the same as the left of the right map etc. # failure to comply are harmless and result in display errors # at worst. sub conn::flood_fill { my ($self, $gx, $gy, $path, $hash, $flags) = @_; # the server does not allow map paths > 6 return if 6 <= length $path; my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}}; for ( [1, 0, -1], [2, 1, 0], [3, 0, 1], [4, -1, 0], ) { my ($tile, $dx, $dy) = @$_; my $gx = $gx + $dx; my $gy = $gy + $dy; next unless $flags & (1 << ($tile - 1)); next if $self->{neigh_grid}{$gx, $gy}++; my $neigh = $self->{neigh_map}{$hash} ||= []; if (my $info = $neigh->[$tile]) { my ($flags, $x, $y, $w, $h, $hash) = @$info; $self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags) if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1; } else { $self->send_mapinfo ("spatial $path$tile", sub { my ($mode, $flags, $x, $y, $w, $h, $hash) = @_; return if $mode ne "spatial"; $x += $MAP->ox; $y += $MAP->oy; $self->load_map ($hash, $x, $y) unless $self->{neigh_map}{$hash}[5]++;#d# $neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash]; $self->flood_fill ($gx, $gy, "$path$tile", $hash, $flags) if $x >= $x0 && $x + $w < $x1 && $y >= $y0 && $y + $h < $y1; }); } } } sub conn::map_change { my ($self, $mode, $flags, $x, $y, $w, $h, $hash) = @_; $self->flush_map; my ($ox, $oy) = ($::MAP->ox, $::MAP->oy); my $mapmapw = 250; my $mapmaph = 250; $self->{neigh_rect} = [ $ox - $mapmapw * 0.5, $oy - $mapmapw * 0.5, $ox + $mapmapw * 0.5 + $w, $oy + $mapmapw * 0.5 + $h, ]; delete $self->{neigh_grid}; $self->flood_fill (0, 0, "", $hash, $flags); $x += $ox; $y += $oy; $self->{map_info} = [$hash, $x, $y, $w, $h]; my $map = $self->{map_info}[0]; $map =~ s/^.*?\/([^\/]+)$/\1/; $STATWIDS->{map}->set_text ("Map: " . $map); $self->load_map ($hash, $x, $y); } sub conn::face_find { my ($self, $facenum, $face) = @_; my $hash = "$face->{chksum},$face->{name}"; my $id = $FACEMAP->get ($hash); unless ($id) { # create new id for face # i love transactions for (1..100) { my $txn = $CFClient::DB_ENV->txn_begin; my $status = $FACEMAP->db_get (id => $id, BerkeleyDB::DB_RMW); if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND) { $id++; if ($FACEMAP->put (id => $id) == 0 && $FACEMAP->put ($hash => $id) == 0) { $txn->txn_commit; goto gotid; } } $txn->abort; } CFClient::fatal "maximum number of transaction retries reached - database problems?"; } gotid: $face->{id} = $id; $MAP->set_face ($facenum => $id); $self->{faceid}[$facenum] = $id;#d# $TILECACHE->get ($id) } sub conn::face_update { my ($self, $facenum, $face) = @_; $TILECACHE->put ($face->{id} => $face->{image}); #TODO: try to avoid duplicate writes $self->set_texture ($face->{id} => delete $face->{image}); } sub conn::set_texture { my ($self, $id, $data) = @_; $self->{texture}[$id] ||= do { my $tex = new_from_image CFClient::Texture $data, minify => 1, mipmap => 1; $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}}); $MAPWIDGET->update; $tex }; } sub conn::sound_play { my ($self, $x, $y, $soundnum, $type) = @_; $SDL_MIXER or return; my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]} or return; $chunk->play; # warn "sound $x,$y,$soundnum,$type\n";#d# } my $LAST_QUERY; # server is stupid, stupid, stupid sub conn::query { my ($self, $flags, $prompt) = @_; $prompt = $LAST_QUERY unless length $prompt; $LAST_QUERY = $prompt; my $dialog = new CFClient::UI::FancyFrame title => "Query", child => my $vbox = new CFClient::UI::VBox; $vbox->add (new CFClient::UI::Label max_w => $::WIDTH * 0.4, text => $prompt); if ($flags & Crossfire::Protocol::CS_QUERY_YESNO) { $vbox->add (my $hbox = new CFClient::HBox); $hbox->add (new CFClient::Button text => "No", connect_activate => sub { $self->send ("reply n"); $dialog->destroy; $MAPWIDGET->focus_in; } ); $hbox->add (new CFClient::Button text => "Yes", connect_activate => sub { $self->send ("reply y"); $dialog->destroy; $MAPWIDGET->focus_in; }, ); $dialog->focus_in; } elsif ($flags & Crossfire::Protocol::CS_QUERY_SINGLECHAR) { $dialog->{tooltip} = "Press a key (click on the entry to make sure it has keyboard focus)"; $vbox->add (my $entry = new CFClient::UI::Entry connect_changed => sub { $self->send ("reply $_[1]"); $dialog->destroy; $MAPWIDGET->focus_in; }, ); $entry->focus_in; } else { $dialog->{tooltip} = "Enter the reply and press return (click on the entry to make sure it has keyboard focus)"; $vbox->add (my $entry = new CFClient::UI::Entry $flags & Crossfire::Protocol::CS_QUERY_HIDEINPUT ? (hiddenchar => "*") : (), connect_activate => sub { $self->send ("reply $_[1]"); $dialog->destroy; $MAPWIDGET->focus_in; }, ); $entry->focus_in; } $dialog->show; } sub conn::drawinfo { my ($self, $color, $text) = @_; my @color = ( [1.00, 1.00, 1.00], #[0.00, 0.00, 0.00], [1.00, 1.00, 1.00], [0.50, 0.50, 1.00], #[0.00, 0.00, 0.55] [1.00, 0.00, 0.00], [1.00, 0.54, 0.00], [0.11, 0.56, 1.00], [0.93, 0.46, 0.00], [0.18, 0.54, 0.34], [0.56, 0.73, 0.56], [0.80, 0.80, 0.80], [0.55, 0.41, 0.13], [0.99, 0.77, 0.26], [0.74, 0.65, 0.41], ); $LOGVIEW->add_paragraph ($color[$color], $text); } sub conn::spell_add { my ($self, $spell) = @_; # TODO # create a widget dynamically, using spell face (CF::Protocol downloads them) $MAPWIDGET->add_command ("invoke $spell->{name}", $spell->{message}); $MAPWIDGET->add_command ("cast $spell->{name}", $spell->{message}); } sub conn::spell_delete { my ($self, $spell) = @_; } sub conn::addme_success { my ($self) = @_; for my $skill (values %{$self->{skill_info}}) { $MAPWIDGET->add_command ("ready_skill $skill", "Ready the skill '$skill'"); $MAPWIDGET->add_command ("use_skill $skill", "Immediately use the skill '$skill'"); } } sub update_floorbox { $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub { $FLOORBOX->clear; $FLOORBOX->add (new CFClient::UI::Empty expand => 1); my @items = values %{ $CONN->{container}{0} }; # we basically have to use the same sorting as everybody else @items = sort { $a->{type} <=> $b->{type} } @items; for my $item (reverse @items) { my $desc = $item->{nrof} < 2 ? $item->{name} : "$item->{nrof} $item->{name_pl}"; # todo: animation widget, face widget, weight(?) etc. $FLOORBOX->add (my $hbox = new CFClient::UI::HBox tooltip => (CFClient::UI::Label->escape ($desc) . "\nleftclick - pick up\nmiddle click - apply\nrightclick - menu"), can_hover => 1, can_events => 1, connect_button_down => sub { my ($self, $ev, $x, $y) = @_; # todo: maybe put examine on 1? but should just be a tooltip :( if ($ev->{button} == 1) { $CONN->send ("move $CONN->{player}{tag} $item->{tag} 0"); } elsif ($ev->{button} == 2) { $CONN->send ("apply $item->{tag}"); } elsif ($ev->{button} == 3) { # examine, lock, mark, maybe other things warn "MENU not implemented yet\n"; } 1 }, ); $hbox->add (new CFClient::UI::Face can_events => 0, face => $item->{face}, anim => $item->{anim}, animspeed => $item->{animspeed}, ); $hbox->add (new CFClient::UI::Label can_events => 0, text => $desc, ); } }); refresh; } sub conn::container_add { my ($self, $id, $items) = @_; update_floorbox if $id == 0; # $self-<{player}{tag} => player inv #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}}; } sub conn::container_clear { my ($self, $id) = @_; update_floorbox if $id == 0; # use PApp::Util; warn PApp::Util::dumpval $self->{container}{0}; } sub conn::item_delete { my ($self, @items) = @_; for (@items) { update_floorbox if $_->{container} == 0; } } sub conn::item_update { my ($self, $item) = @_; update_floorbox if $item->{container} == 0; } %SDL_CB = ( CFClient::SDL_QUIT => sub { Event::unloop -1; }, CFClient::SDL_VIDEORESIZE => sub { }, CFClient::SDL_VIDEOEXPOSE => \&refresh, CFClient::SDL_ACTIVEEVENT => sub { # printf "active %x %x\n", $SDL_EV->active_gain, $SDL_EV->active_state;#d# }, CFClient::SDL_KEYDOWN => sub { if ($_[0]{mod} & CFClient::KMOD_ALT && $_[0]{sym} == 13) { # alt-enter video_shutdown; $CFG->{fullscreen} = !$CFG->{fullscreen}; video_init; } else { CFClient::UI::feed_sdl_key_down_event ($_[0]); } }, CFClient::SDL_KEYUP => \&CFClient::UI::feed_sdl_key_up_event, CFClient::SDL_MOUSEMOTION => \&CFClient::UI::feed_sdl_motion_event, CFClient::SDL_MOUSEBUTTONDOWN => \&CFClient::UI::feed_sdl_button_down_event, CFClient::SDL_MOUSEBUTTONUP => \&CFClient::UI::feed_sdl_button_up_event, CFClient::SDL_USEREVENT => \&audio_music_finished, ); ############################################################################# $SIG{INT} = $SIG{TERM} = sub { exit }; $TILECACHE = CFClient::db_table "tilecache"; $FACEMAP = CFClient::db_table "facemap"; CFClient::read_cfg "$Crossfire::VARDIR/pclientrc"; my %DEF_CFG = ( sdl_mode => 0, width => 640, height => 480, fullscreen => 0, fast => 0, map_scale => 0.5, fow_enable => 1, fow_intensity => 0.45, fow_smooth => 0, gui_fontsize => 1, log_fontsize => 1, gauge_fontsize => 1, gauge_size => 0.35, stat_fontsize => 1, mapsize => 100, host => "crossfire.schmorp.de", say_command => 'say', audio_enable => 1, bgm_enable => 1, bgm_volume => 0.25, ); while (my ($k, $v) = each %DEF_CFG) { $CFG->{$k} = $v unless exists $CFG->{$k}; } sdl_init; @SDL_MODES = reverse grep $_->[0] >= 640 && $_->[1] >= 480, CFClient::SDL_ListModes; @SDL_MODES or CFClient::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 CFClient::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 ); CFClient::add_font $_ for @fonts; $FONT_PROP = new_from_file CFClient::Font $fonts[0]; $FONT_FIXED = new_from_file CFClient::Font $fonts[1]; $FONT_PROP->make_default; } video_init; audio_init; Event::loop; END { CFClient::SDL_Quit } =head1 pclient - Crossfire+ and Crossfire game client Pclient is a Crossfire+ and Crossfire game client. =head2 Features =over 4 =item Fullscreen Map PClient can uses a fullscreen map, which greatly enhances how much of the game world you can see. =item Persistent Map Cache (Crossfire+ only) PClient can persistently cache all map data it received from the server. This not only allows it to display an overview map, but also ensures that once-explored areas will be available the next time you want to explore more. =item Hardware acceleration Unlike most Crossfire clients, PClient take advantage of OpenGL hardware acceleration. Most modern graphics cards have difficulties with 2D acceleration, while 3D graphics is accelerated well. =item No arbitrary limits Unlike other Crossfire clients, pclient does not suffer from arbitrary limits (like a fixed amount of face numbers). There are still limits, but they are not arbitrarily low :) =back =head1 FAQ =over 4 =item The client is very sluggish and slow, what can I do about this? Most likely, you don't have accelerated OpenGL support. Try to find a newer driver, or a driver from your hardware vendor, that features OpenGL support. If this is not an option, the following Setup options reduce the load and will likely make the client playable with sofwtare rendering (it will still be slow, though): =over 4 =item B