#!/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]);
$table->add (0, 1, new CFClient::UI::Label valign => 0, align => 1, text => "Fullscreen");
$table->add (1, 1, new CFClient::UI::CheckBox state => $CFG->{fullscreen}, connect_changed => sub {
my ($self, $value) = @_;
$CFG->{fullscreen} = $value;
});
$table->add (0, 2, new CFClient::UI::Label valign => 0, align => 1, text => "Fast & Ugly");
$table->add (1, 2, new CFClient::UI::CheckBox state => $CFG->{fast}, connect_changed => sub {
my ($self, $value) = @_;
$CFG->{fast} = $value;
});
$table->add (0, 3, new CFClient::UI::Label valign => 0, align => 1, text => "Fog of War");
$table->add (1, 3, new CFClient::UI::CheckBox state => $CFG->{fow_enable}, connect_changed => sub {
my ($self, $value) = @_;
$CFG->{fow_enable} = $value;
});
$table->add (0, 4, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Intensity");
$table->add (1, 4, 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, 5, new CFClient::UI::Label valign => 0, align => 1, text => "FoW Smooth");
$table->add (1, 5, 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, 6, new CFClient::UI::Label valign => 0, align => 1, text => "GUI Fontsize");
$table->add (1, 6, 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, 7, new CFClient::UI::Label valign => 0, align => 1, text => "Server Log Fontsize");
$table->add (1, 7, 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 (1, 8, new CFClient::UI::Button expand => 1, align => 0, text => "Apply", connect_activate => sub {
video_shutdown ();
video_init ();
});
$table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Audio Enable");
$table->add (1, 9, 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, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");
$table->add (1, 10, 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, 11, new CFClient::UI::Button expand => 1, align => 0, text => "Apply", connect_activate => sub {
audio_shutdown ();
audio_init ();
});
$dialog
}
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:");
$vb->add (my $lhb = new CFClient::UI::HBox);
$lhb->add ($STATWIDS->{exp} = new CFClient::UI::Label valign => 0, align => -1, text => "Exp:", expand => 1);
$lhb->add ($STATWIDS->{lvl} = new CFClient::UI::Label valign => 0, align => -1, text => "Level:", expand => 1);
$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);
$GAUGES = { food => $fg, mana => $mg, hp => $hg, grace => $gg };
$hb->add (my $tbl = new CFClient::UI::Table expand => 1);
if (0) { # this code can vanish, just wanted to preserver it for a checkin
$tbl->add (0, 0, $STATWIDS->{st_str} = new CFClient::UI::Label valign => 0, align => -1, text => "S");
$tbl->add (0, 1, $STATWIDS->{st_dex} = new CFClient::UI::Label valign => 0, align => -1, text => "D");
$tbl->add (0, 2, $STATWIDS->{st_con} = new CFClient::UI::Label valign => 0, align => -1, text => "Co");
$tbl->add (0, 3, $STATWIDS->{st_int} = new CFClient::UI::Label valign => 0, align => -1, text => "I");
$tbl->add (0, 4, $STATWIDS->{st_wis} = new CFClient::UI::Label valign => 0, align => -1, text => "W");
$tbl->add (0, 5, $STATWIDS->{st_pow} = new CFClient::UI::Label valign => 0, align => -1, text => "P");
$tbl->add (0, 6, $STATWIDS->{st_cha} = new CFClient::UI::Label valign => 0, align => -1, text => "Ch");
$tbl->add (1, 0, $STATWIDS->{st_wc} = new CFClient::UI::Label valign => 0, align => -1, text => "Wc");
$tbl->add (1, 1, $STATWIDS->{st_ac} = new CFClient::UI::Label valign => 0, align => -1, text => "Ac");
$tbl->add (1, 2, $STATWIDS->{st_dam} = new CFClient::UI::Label valign => 0, align => -1, text => "Dam");
$tbl->add (1, 3, $STATWIDS->{st_arm} = new CFClient::UI::Label valign => 0, align => -1, text => "Arm");
$tbl->add (1, 4, $STATWIDS->{st_spd} = new CFClient::UI::Label valign => 0, align => -1, text => "Sp");
$tbl->add (1, 5, $STATWIDS->{st_wspd} = new CFClient::UI::Label valign => 0, align => -1, text => "WSp");
} else {
$tbl->add (0, 0, new CFClient::UI::Label valign => 0, align => +1, text => "S");
$tbl->add (0, 1, new CFClient::UI::Label valign => 0, align => +1, text => "D");
$tbl->add (0, 2, new CFClient::UI::Label valign => 0, align => +1, text => "Co");
$tbl->add (0, 3, new CFClient::UI::Label valign => 0, align => +1, text => "I");
$tbl->add (0, 4, new CFClient::UI::Label valign => 0, align => +1, text => "W");
$tbl->add (0, 5, new CFClient::UI::Label valign => 0, align => +1, text => "P");
$tbl->add (0, 6, 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, new CFClient::UI::Label valign => 0, align => +1, text => "Wc");
$tbl->add (2, 1, new CFClient::UI::Label valign => 0, align => +1, text => "Ac");
$tbl->add (2, 2, new CFClient::UI::Label valign => 0, align => +1, text => "Dam");
$tbl->add (2, 3, new CFClient::UI::Label valign => 0, align => +1, text => "Arm");
$tbl->add (2, 4, new CFClient::UI::Label valign => 0, align => +1, text => "Sp");
$tbl->add (2, 5, 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);
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;
}
}
update_stats_window ({});
$tgw
}
sub update_stats_window {
my ($stats) = @_;
# i love text protocols!!!
my $hp = $stats->{1};
my $hp_m = $stats->{2};
my $sp = $stats->{3};
my $sp_m = $stats->{4};
my $fo = $stats->{18};
my $fo_m = 999;
my $gr = $stats->{23};
my $gr_m = $stats->{24};
$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);
$STATWIDS->{title} ->set_text ("Title: " . $stats->{21});
$STATWIDS->{exp} ->set_text ("Exp.: " . ($stats->{11} || $stats->{28}));
$STATWIDS->{lvl} ->set_text ("Level: " . $stats->{12});
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/