#!/opt/bin/perl
use strict;
use utf8;
use Time::HiRes 'time';
use Event;
use Crossfire;
use Crossfire::Protocol;
use Compress::LZF;
use CFClient;
use CFClient::UI;
use CFClient::MapWidget;
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 $MAP;
our $MAPWIDGET;
our $BUTTONBAR;
our $LOGVIEW;
our $CONSOLE;
our $METASERVER;
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}, 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}, connect_changed => sub {
my ($self, $value) = @_;
$CFG->{fast} = $value;
});
$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}, 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], 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}, 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.7, 1.7, 0.1], 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.7, 1.7, 0.1], 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.7, 1.7, 0.1], 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 width");
$table->add (1, $row++, new CFClient::UI::Slider range => [$CFG->{gauge_w_size}, 0.1, 0.5, 0.02], connect_changed => sub {
$CFG->{gauge_w_size} = $_[1];
my $h = int ($HEIGHT * $CFG->{gauge_size});
my $w = int ($WIDTH * $CFG->{gauge_w_size});
$GAUGES->{win}->set_size ($w, $h);
$GAUGES->{win}->{y} = $HEIGHT - $h;
$GAUGES->{win}->{x} = $WIDTH - $w;
$GAUGES->{win}->update;
});
$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Gauge height");
$table->add (1, $row++, new CFClient::UI::Slider range => [$CFG->{gauge_size}, 0.2, 0.8, 0.02], connect_changed => sub {
$CFG->{gauge_size} = $_[1];
my $h = int ($HEIGHT * $CFG->{gauge_size});
my $w = int ($WIDTH * $CFG->{gauge_w_size});
$GAUGES->{win}->set_size ($w, $h);
$GAUGES->{win}->{y} = $HEIGHT - $h;
$GAUGES->{win}->{x} = $WIDTH - $w;
$GAUGES->{win}->update;
});
$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.7, 1.7, 0.1], connect_changed => sub {
$CFG->{gauge_fontsize} = 0.1 * int $_[1] * 10;
&set_gauge_window_fontsize;
$GAUGES->{win}->check_size;
$GAUGES->{win}->update;
});
$table->add (1, $row++, new CFClient::UI::Button expand => 1, align => 0, text => "Apply", 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}, 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}, connect_changed => sub {
$CFG->{bgm_enable} = $_[1];
});
$hbox->add (new CFClient::UI::Slider expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0.1], 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", 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});
}
}
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 => $WIDTH - $gw, req_w => $gw, req_h => $gh
);
$win->add (my $vb = new CFClient::UI::VBox);
$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
$hb->add (my $hg = new CFClient::UI::Gauge type => 'hp', expand => 1);
$hb->add (my $mg = new CFClient::UI::Gauge type => 'mana', expand => 1);
$hb->add (my $gg = new CFClient::UI::Gauge type => 'grace', expand => 1);
$hb->add (my $fg = new CFClient::UI::Gauge type => 'food', expand => 1);
$vb->add (my $exp = new CFClient::UI::Label valign => 0, align => -1, text => "XP:");
$vb->add (my $lvl = new CFClient::UI::Label valign => 0, align => -1, text => "Lvl:");
$vb->add (my $rng = new CFClient::UI::Label valign => 0, align => -1, text => "Rng:");
$GAUGES = {
exp => $exp, lvl => $lvl, win => $win, range => $rng,
food => $fg, mana => $mg, hp => $hg, grace => $gg
};
$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 (my $uhb = new CFClient::UI::HBox);
$uhb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1);
$uhb->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);
$tbl->add (0, 0, $STATWIDS->{st_str_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "S");
$tbl->add (0, 1, $STATWIDS->{st_dex_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "D");
$tbl->add (0, 2, $STATWIDS->{st_con_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Co");
$tbl->add (0, 3, $STATWIDS->{st_int_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "I");
$tbl->add (0, 4, $STATWIDS->{st_wis_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "W");
$tbl->add (0, 5, $STATWIDS->{st_pow_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "P");
$tbl->add (0, 6, $STATWIDS->{st_cha_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Ch");
$tbl->add (1, 0, $STATWIDS->{st_str} = new CFClient::UI::Label valign => 0, align => -1, text => "");
$tbl->add (1, 1, $STATWIDS->{st_dex} = new CFClient::UI::Label valign => 0, align => -1, text => "");
$tbl->add (1, 2, $STATWIDS->{st_con} = new CFClient::UI::Label valign => 0, align => -1, text => "");
$tbl->add (1, 3, $STATWIDS->{st_int} = new CFClient::UI::Label valign => 0, align => -1, text => "");
$tbl->add (1, 4, $STATWIDS->{st_wis} = new CFClient::UI::Label valign => 0, align => -1, text => "");
$tbl->add (1, 5, $STATWIDS->{st_pow} = new CFClient::UI::Label valign => 0, align => -1, text => "");
$tbl->add (1, 6, $STATWIDS->{st_cha} = new CFClient::UI::Label valign => 0, align => -1, text => "");
$tbl->add (2, 0, $STATWIDS->{st_wc_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Wc");
$tbl->add (2, 1, $STATWIDS->{st_ac_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Ac");
$tbl->add (2, 2, $STATWIDS->{st_dam_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Dam");
$tbl->add (2, 3, $STATWIDS->{st_arm_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Arm");
$tbl->add (2, 4, $STATWIDS->{st_spd_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "Sp");
$tbl->add (2, 5, $STATWIDS->{st_wspd_lbl} = new CFClient::UI::Label valign => 0, align => +1, text => "WSp");
$tbl->add (3, 0, $STATWIDS->{st_wc} = new CFClient::UI::Label valign => 0, align => -1, text => "");
$tbl->add (3, 1, $STATWIDS->{st_ac} = new CFClient::UI::Label valign => 0, align => -1, text => "");
$tbl->add (3, 2, $STATWIDS->{st_dam} = new CFClient::UI::Label valign => 0, align => -1, text => "");
$tbl->add (3, 3, $STATWIDS->{st_arm} = new CFClient::UI::Label valign => 0, align => -1, text => "");
$tbl->add (3, 4, $STATWIDS->{st_spd} = new CFClient::UI::Label valign => 0, align => -1, text => "");
$tbl->add (3, 5, $STATWIDS->{st_wspd} = new CFClient::UI::Label valign => 0, align => -1, text => "");
$hb->add (my $tbl2 = new CFClient::UI::Table expand => 1);
my $row = 0;
my $col = 0;
for (qw/slow holyw conf fire depl magic
drain acid pois para deat phys
blind fear tund elec cold ghit/)
{
$tbl2->add ($col, $row, new CFClient::UI::Image image => "ui/resist/resist_$_.png");
$tbl2->add ($col + 1, $row,
$STATWIDS->{"res_$_"} =
new CFClient::UI::Label text => "0", align => -1, valign => 0
);
$row++;
if ($row % 6 == 0) {
$col += 2;
$row = 0;
}
}
&set_stats_window_fontsize;
update_stats_window ({});
$tgw
}
sub update_stats_window {
my ($stats) = @_;
# i love text protocols!!!
my $hp = $stats->{1} * 1;
my $hp_m = $stats->{2} * 1;
my $sp = $stats->{3} * 1;
my $sp_m = $stats->{4} * 1;
my $fo = $stats->{18} * 1;
my $fo_m = 999;
my $gr = $stats->{23} * 1;
my $gr_m = $stats->{24} * 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 ("XP: " . ($stats->{11} || $stats->{28}));
my $rng = $stats->{20};
$rng =~ s/^Range: //; # thank you so much dear server
$GAUGES->{range} ->set_text ("Rng: " . $rng);
$GAUGES->{lvl} ->set_text ("LVL: " . $stats->{12});
$STATWIDS->{title} ->set_text ("Title: " . $stats->{21});
if (0) { # this code can vanish, just wanted to preserver it for a checkin
$STATWIDS->{st_str} ->set_text (sprintf "S%d", $stats->{5});
$STATWIDS->{st_dex} ->set_text (sprintf "D%d", $stats->{8});
$STATWIDS->{st_con} ->set_text (sprintf "Co%d", $stats->{9});
$STATWIDS->{st_int} ->set_text (sprintf "I%d", $stats->{6});
$STATWIDS->{st_wis} ->set_text (sprintf "W%d", $stats->{7});
$STATWIDS->{st_pow} ->set_text (sprintf "P%d", $stats->{22});
$STATWIDS->{st_cha} ->set_text (sprintf "Ch%d", $stats->{10});
$STATWIDS->{st_wc} ->set_text (sprintf "Wc%d", $stats->{13});
$STATWIDS->{st_ac} ->set_text (sprintf "Ac%d", $stats->{14});
$STATWIDS->{st_dam} ->set_text (sprintf "Dam%d", $stats->{15});
$STATWIDS->{st_arm} ->set_text (sprintf "Arm%d", $stats->{16});
$STATWIDS->{st_spd} ->set_text (sprintf "Sp%.1f", $stats->{17});
$STATWIDS->{st_wspd}->set_text (sprintf "WSp%.1f", $stats->{19});
} else {
$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->{17});
$STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{19});
}
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,
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) = @_;
status "fetching metaserver list...";
my $buf;
my $fh = new IO::Socket::INET PeerHost => $META_SERVER, Blocking => 0;
Event->io (fd => $fh, poll => 'r', cb => sub {
my $res = sysread $fh, $buf, 8192, length $buf;
if (!defined $res) {
$_[0]->w->cancel;
status "metaserver: $!";
} elsif ($res == 0) {
$_[0]->w->cancel;
status "server list retrieved";
my $table = $METASERVER->{table};
$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/