--- deliantra/Deliantra-Client/bin/cfplus 2006/05/25 22:37:30 1.8
+++ deliantra/Deliantra-Client/bin/cfplus 2006/06/05 22:30:35 1.59
@@ -27,20 +27,24 @@
if %PAR::LibCache;
use Time::HiRes 'time';
-use Pod::POM;
use Event;
use Crossfire;
-use Crossfire::Protocol;
+use Crossfire::Protocol::Constants;
use Compress::LZF;
use CFClient;
+use CFClient::OpenGL ();
+use CFClient::Protocol;
use CFClient::UI;
use CFClient::MapWidget;
+$SIG{QUIT} = sub { Carp::cluck "QUIT" };
+
$Event::DIED = sub {
# TODO: display dialog box or so
+ Carp::confess $_[1];#d#TODO: remove when stable
CFClient::error $_[1];
};
@@ -53,10 +57,6 @@
our $META_SERVER = "crossfire.real-time.com:13326";
-our $FACEMAP;
-our $TILECACHE;
-our $MAPCACHE;
-
our $LAST_REFRESH;
our $NOW;
@@ -85,6 +85,13 @@
our $METASERVER;
our $LOGIN_BUTTON;
our $QUIT_DIALOG;
+our $HOST_ENTRY;
+
+our $SETUP_DIALOG;
+our $SETUP_NOTEBOOK;
+our $SETUP_SERVER;
+our $SETUP_KEYBOARD;
+our $SETUP_SPELLS;
our $FLOORBOX;
our $GAUGES;
@@ -101,10 +108,14 @@
our $STATUSBOX;
our $DEBUG_STATUS;
-our $INVWIN;
+our $INV_WINDOW;
our $INV;
our $INVR;
-our $INVR_LBL;
+our $INV_RIGHT_HB;
+
+our $BIND_EDITOR;
+
+our $PICKUP_CFG;
sub status {
$STATUSBOX->add (CFClient::UI::Label::escape $_[0], pri => -10, group => "status", timeout => 10, fg => [1, 1, 0, 1]);
@@ -112,40 +123,52 @@
sub debug {
$DEBUG_STATUS->set_text ($_[0]);
- my ($w, $h) = $DEBUG_STATUS->size_request;
- $DEBUG_STATUS->move ($WIDTH - $w, 0);
}
sub start_game {
status "logging in...";
- my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
+ $LOGIN_BUTTON->set_text ("Logout");
+ $SETUP_DIALOG->hide;
- $MAPCACHE = CFClient::db_table "mapcache_$CFG->{host}";
- $MAP = new CFClient::Map $mapsize, $mapsize;
+ my $mapsize = List::Util::min 32, List::Util::max 11, int $WIDTH * $CFG->{mapsize} * 0.01 / 32;
my ($host, $port) = split /:/, $CFG->{host};
+
+ $MAP = new CFClient::Map $mapsize, $mapsize;
$CONN = eval {
- new conn
+ new CFClient::Protocol
host => $host,
port => $port || 13327,
user => $CFG->{user},
pass => $CFG->{password},
mapw => $mapsize,
maph => $mapsize,
- ;
+
+ map_widget => $MAPWIDGET,
+ logview => $LOGVIEW,
+ statusbox => $STATUSBOX,
+ map => $MAP,
+ mapmap => $MAPMAP,
+
+ sound_play => sub {
+ my ($x, $y, $soundnum, $type) = @_;
+
+ $SDL_MIXER
+ or return;
+
+ my $chunk = $AUDIO_CHUNKS{$SOUNDS[$soundnum]}
+ or return;
+
+ $chunk->play;
+ },
};
if ($CONN) {
CFClient::lowdelay fileno $CONN->{fh};
- $LOGIN_BUTTON->set_text ("Logout");
status "login successful";
-
- $BUTTONBAR->{children}[1]->emit ("activate")
- if $BUTTONBAR->{children}[1]->{state};
-
} else {
status "unable to connect";
stop_game();
@@ -153,30 +176,28 @@
}
sub stop_game {
+ $LOGIN_BUTTON->set_text ("Login");
+ $SETUP_NOTEBOOK->set_current_page ($SETUP_SERVER);
+ $SETUP_DIALOG->show;
+ $INV_WINDOW->hide;
+
return unless $CONN;
status "connection closed";
- $LOGIN_BUTTON->set_text ("Login");
+
$CONN->destroy;
$CONN = 0; # false, does not autovivify
-
- $BUTTONBAR->{children}[1]->emit ("activate")
- unless $BUTTONBAR->{children}[1]->{state};
-
- undef $MAPCACHE;
- undef $MAP;
}
-sub client_setup {
- my $dialog = new CFClient::UI::FancyFrame
- title => "Client Setup",
- child => (my $vbox = new CFClient::UI::VBox);
+sub graphics_setup {
+ 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, $#SDL_MODES, 0, 1]);
+ $hbox->add (my $mode_slider = new CFClient::UI::Slider force_w => $WIDTH * 0.1, expand => 1, range => [$CFG->{sdl_mode}, 0, $#SDL_MODES, 0, 1]);
$hbox->add (my $mode_label = new CFClient::UI::Label align => 0, valign => 0, height => 0.8, template => "9999x9999");
$mode_slider->connect (changed => sub {
@@ -193,7 +214,7 @@
$table->add (1, $row++, new CFClient::UI::CheckBox
state => $CFG->{fullscreen},
tooltip => "Bring the client into fullscreen mode.",
- connect_changed => sub {
+ on_changed => sub {
my ($self, $value) = @_;
$CFG->{fullscreen} = $value;
}
@@ -203,7 +224,7 @@
$table->add (1, $row++, new CFClient::UI::CheckBox
state => $CFG->{fast},
tooltip => "Lower the visual quality considerably to speed up rendering.",
- connect_changed => sub {
+ on_changed => sub {
my ($self, $value) = @_;
$CFG->{fast} = $value;
}
@@ -213,7 +234,7 @@
$table->add (1, $row++, new CFClient::UI::Slider
range => [(log $CFG->{map_scale}) / (log 2), -3, 1, 0, 1],
tooltip => "Enlarge or shrink the displayed map. Changes are instant.",
- connect_changed => sub {
+ on_changed => sub {
my ($self, $value) = @_;
$CFG->{map_scale} = 2 ** $value;
}
@@ -223,7 +244,7 @@
$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. Changes are instant.",
- connect_changed => sub {
+ on_changed => sub {
my ($self, $value) = @_;
$CFG->{fow_enable} = $value;
}
@@ -233,7 +254,7 @@
$table->add (1, $row++, new CFClient::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.",
- connect_changed => sub {
+ on_changed => sub {
my ($self, $value) = @_;
$CFG->{fow_intensity} = $value;
}
@@ -243,10 +264,10 @@
$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. Changes are instant.",
- connect_changed => sub {
+ on_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;
+ status "Fog of War smoothing requires OpenGL 1.2 or higher" if $CFClient::OpenGL::GL_VERSION < 1.2;
}
);
@@ -254,14 +275,14 @@
$table->add (1, $row++, new CFClient::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.",
- connect_changed => sub { $CFG->{gui_fontsize} = $_[1] },
+ on_changed => sub { $CFG->{gui_fontsize} = $_[1] },
);
$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Message Fontsize");
$table->add (1, $row++, new CFClient::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.",
- connect_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]) },
+ on_changed => sub { $LOGVIEW->set_fontsize ($CFG->{log_fontsize} = $_[1]) },
);
$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Stats Fontsize");
@@ -269,7 +290,7 @@
$table->add (1, $row++, new CFClient::UI::Slider
range => [$CFG->{stat_fontsize}, 0.5, 2, 0, 0.1],
tooltip => "The font size used by the statistics window only. Changes are instant.",
- connect_changed => sub {
+ on_changed => sub {
$CFG->{stat_fontsize} = $_[1];
&set_stats_window_fontsize;
}
@@ -279,7 +300,7 @@
$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. Changes are instant.",
- connect_changed => sub {
+ on_changed => sub {
$CFG->{gauge_fontsize} = $_[1];
&set_gauge_window_fontsize;
}
@@ -287,9 +308,9 @@
$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],
- tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",
- connect_changed => sub {
+ range => [$CFG->{gauge_size}, 0.2, 0.8],
+ tooltip => "Adjust the size of the stats gauges at the bottom right. Changes are instant.",
+ on_changed => sub {
$CFG->{gauge_size} = $_[1];
$GAUGES->{win}->set_size ($WIDTH, int $HEIGHT * $CFG->{gauge_size});
}
@@ -298,22 +319,32 @@
$table->add (1, $row++, new CFClient::UI::Button
expand => 1, align => 0, text => "Apply",
tooltip => "Apply the video settings",
- connect_activate => sub {
+ on_activate => sub {
video_shutdown ();
video_init ();
}
);
+ $vbox
+}
+
+sub audio_setup {
+ my $vbox = new CFClient::UI::VBox;
+
+ $vbox->add (my $table = new CFClient::UI::Table expand => 1, col_expand => [0, 1]);
+
+ my $row = 0;
+
$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 => "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.",
- connect_changed => sub {
+ on_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 {
+# $table->add (1, 8, new CFClient::UI::Slider range => [$CFG->{effects_volume}, 0, 128, 1], on_changed => sub {
# $CFG->{effects_volume} = $_[1];
# });
$table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Background Music");
@@ -321,14 +352,14 @@
$hbox->add (new CFClient::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.",
- connect_changed => sub {
+ on_changed => sub {
$CFG->{bgm_enable} = $_[1];
}
);
$hbox->add (new CFClient::UI::Slider
expand => 1, range => [$CFG->{bgm_volume}, 0, 1, 0, 1/128],
tooltip => "The volume of the background music. Changes are instant.",
- connect_changed => sub {
+ on_changed => sub {
$CFG->{bgm_volume} = $_[1];
CFClient::MixMusic::volume $_[1] * 128;
}
@@ -337,25 +368,13 @@
$table->add (1, $row++, new CFClient::UI::Button
expand => 1, align => 0, text => "Apply",
tooltip => "Apply the audio settings",
- connect_activate => sub {
+ on_activate => sub {
audio_shutdown ();
audio_init ();
}
);
- $table->add (0, $row, new CFClient::UI::Label valign => 0, align => 1, text => "Chat Command");
- $table->add (1, $row++, 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 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.",
- connect_changed => sub {
- my ($self, $value) = @_;
- $CFG->{say_command} = $value;
- }
- );
-
- $dialog
+ $vbox
}
sub set_stats_window_fontsize {
@@ -374,9 +393,10 @@
my $gh = int $HEIGHT * $CFG->{gauge_size};
my $win = new CFClient::UI::Frame (
- req_y => -1,
- user_w => $WIDTH,
- user_h => $gh,
+ force_x => 0,
+ force_y => "max",
+ force_w => $WIDTH,
+ force_h => $gh,
);
$win->add (my $hbox = new CFClient::UI::HBox
@@ -422,8 +442,13 @@
$win
}
+
sub make_stats_window {
- my $tgw = new CFClient::UI::FancyFrame title => "Stats";
+ my $tgw = new CFClient::UI::FancyFrame
+ y => $HEIGHT * (2/8),
+ x => "max",
+ title => "Stats",
+ name => "stats_window";
$tgw->add (new CFClient::UI::Window child => my $vb = new CFClient::UI::VBox);
$vb->add ($STATWIDS->{title} = new CFClient::UI::Label valign => 0, align => -1, text => "Title:", expand => 1,
@@ -436,10 +461,10 @@
$vb->add (my $hb0 = new CFClient::UI::HBox);
$hb0->add ($STATWIDS->{weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Weight:", expand => 1,
can_hover => 1, can_events => 1,
- tooltip => "This is the amount the Player weights.");
+ tooltip => "The weight of the player including all inventory items.");
$hb0->add ($STATWIDS->{m_weight} = new CFClient::UI::Label valign => 0, align => -1, text => "Max weight:", expand => 1,
can_hover => 1, can_events => 1,
- tooltip => "The weight limit, you can't carry more than this.");
+ tooltip => "The weight limit: you cannot carry more than this.");
$vb->add (my $hb = new CFClient::UI::HBox expand => 1);
@@ -532,52 +557,54 @@
$tgw
}
-sub formsep {
- reverse join ",", grep length, split /(...)/, reverse $_[0] * 1
+sub formsep($) {
+ scalar reverse join ",", unpack "(A3)*", 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;
+ # I love text protocols...
+
+ my $hp = $stats->{+CS_STAT_HP} * 1;
+ my $hp_m = $stats->{+CS_STAT_MAXHP} * 1;
+ my $sp = $stats->{+CS_STAT_SP} * 1;
+ my $sp_m = $stats->{+CS_STAT_MAXSP} * 1;
+ my $fo = $stats->{+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;
+ my $gr = $stats->{+CS_STAT_GRACE} * 1;
+ my $gr_m = $stats->{+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};
+ $GAUGES->{exp} ->set_text ("Exp: " . (formsep $stats->{+CS_STAT_EXP64})
+ . " (lvl " . ($stats->{+CS_STAT_LEVEL} * 1) . ")");
+ my $rng = $stats->{+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};
+ my $title = $stats->{+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});
+ $STATWIDS->{st_str} ->set_text (sprintf "%d" , $stats->{+CS_STAT_STR});
+ $STATWIDS->{st_dex} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DEX});
+ $STATWIDS->{st_con} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CON});
+ $STATWIDS->{st_int} ->set_text (sprintf "%d" , $stats->{+CS_STAT_INT});
+ $STATWIDS->{st_wis} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WIS});
+ $STATWIDS->{st_pow} ->set_text (sprintf "%d" , $stats->{+CS_STAT_POW});
+ $STATWIDS->{st_cha} ->set_text (sprintf "%d" , $stats->{+CS_STAT_CHA});
+ $STATWIDS->{st_wc} ->set_text (sprintf "%d" , $stats->{+CS_STAT_WC});
+ $STATWIDS->{st_ac} ->set_text (sprintf "%d" , $stats->{+CS_STAT_AC});
+ $STATWIDS->{st_dam} ->set_text (sprintf "%d" , $stats->{+CS_STAT_DAM});
+ $STATWIDS->{st_arm} ->set_text (sprintf "%d" , $stats->{+CS_STAT_ARMOUR});
+ $STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{+CS_STAT_SPEED});
+ $STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{+CS_STAT_WEAP_SP});
- $STATWIDS->{m_weight}->set_text (sprintf "Max weight: %.1fkg", $stats->{Crossfire::Protocol::CS_STAT_WEIGHT_LIM} / 1000);
+ $STATWIDS->{m_weight}->set_text (sprintf "Max weight: %.1fkg", $stats->{+CS_STAT_WEIGHT_LIM} / 1000);
+ # TODO: replace by CS_STAT_RES_xxx constants
my %tbl = (
phys => 100,
magic => 101,
@@ -596,30 +623,16 @@
depl => 113,
deat => 115,
holyw => 116,
- blind => 117
+ blind => 117,
);
- for (keys %tbl) {
- $STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}});
- }
-
-}
-
-sub metaserver_dialog {
- my $dialog = new CFClient::UI::FancyFrame
- title => "Server List",
- child => (my $vbox = new CFClient::UI::VBox);
-
- $vbox->add ($dialog->{table} = new CFClient::UI::Table);
-
- $dialog
+ $STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$tbl{$_}})
+ for keys %tbl;
}
my $METASERVER_ATIME;
sub update_metaserver {
- my ($HOST) = @_;
-
return if $METASERVER_ATIME > time;
$METASERVER_ATIME = time + 60;
@@ -680,8 +693,9 @@
$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::Button text => "Use", on_activate => sub {
+ $HOST_ENTRY->set_text ($CFG->{host} = $host);
+ $METASERVER->toggle_visibility;
}),
(new CFClient::UI::Empty expand => 1),
]);
@@ -694,11 +708,27 @@
});
}
-sub server_setup {
+sub metaserver_dialog {
my $dialog = new CFClient::UI::FancyFrame
- title => "Server Setup",
- child => (my $vbox = new CFClient::UI::VBox);
-
+ title => "Server List",
+ name => 'metaserver_dialog',
+ x => 'center',
+ y => 'center',
+ z => 3,
+ child => (my $vbox = new CFClient::UI::VBox),
+ on_visibility_change => sub {
+ update_metaserver if $_[1];
+ },
+ ;
+
+ $vbox->add ($dialog->{table} = new CFClient::UI::Table);
+
+ $dialog
+}
+
+sub server_setup {
+ 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");
@@ -706,11 +736,11 @@
$table->add (1, 2, my $vbox = new CFClient::UI::VBox);
$vbox->add (
- my $HOST = new CFClient::UI::Entry
+ $HOST_ENTRY = 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 {
+ on_changed => sub {
my ($self, $value) = @_;
$CFG->{host} = $value;
}
@@ -718,14 +748,12 @@
$METASERVER = metaserver_dialog;
- $vbox->add (new CFClient::UI::Flopper
- expand => 1,
- text => "Server List",
- other => $METASERVER,
+ $vbox->add (new CFClient::UI::Button
+ expand => 1,
+ text => "Server List",
+ other => $METASERVER,
tooltip => "Show a list of available crossfire servers",
- connect_open => sub {
- update_metaserver $HOST;
- }
+ on_activate => sub { $METASERVER->toggle_visibility },
);
}
@@ -733,7 +761,7 @@
$table->add (1, 4, new CFClient::UI::Entry
text => $CFG->{user},
tooltip => "The name of your character on the server",
- connect_changed => sub {
+ on_changed => sub {
my ($self, $value) = @_;
$CFG->{user} = $value;
}
@@ -744,7 +772,7 @@
text => $CFG->{password},
hidden => 1,
tooltip => "The password for your character",
- connect_changed => sub {
+ on_changed => sub {
my ($self, $value) = @_;
$CFG->{password} = $value;
}
@@ -752,13 +780,13 @@
$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,
+ force_w => 100,
range => [$CFG->{mapsize}, 10, 100, 0, 1],
tooltip => "This is the size of the portion of the map update the server sends you. "
. "If you set this to a high value you will be able to see further, "
. "but you also increase bandwidth requirements and latency. "
. "This option is only used once at log-in.",
- connect_changed => sub {
+ on_changed => sub {
my ($self, $value) = @_;
$CFG->{mapsize} = $self->{range}[0] = $value = int $value;
@@ -775,43 +803,58 @@
. "It also uses up server bandwidth on every connect, "
. "so only set it if you really need to prefetch images. "
. "This option can be set and unset any time.",
- connect_changed => sub { $CFG->{face_prefetch} = $_[1] },
+ on_changed => sub { $CFG->{face_prefetch} = $_[1] },
);
$table->add (0, 9, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Count");
$table->add (1, 9, new CFClient::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.",
- connect_changed => sub { $CFG->{output_count} = $_[1] },
+ on_changed => sub { $CFG->{output_count} = $_[1] },
);
$table->add (0, 10, new CFClient::UI::Label valign => 0, align => 1, text => "Output-Sync");
$table->add (1, 10, new CFClient::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.",
- connect_changed => sub { $CFG->{output_sync} = $_[1] },
+ on_changed => sub { $CFG->{output_sync} = $_[1] },
);
$table->add (1, 11, $LOGIN_BUTTON = new CFClient::UI::Button
expand => 1,
align => 0,
text => "Login",
- connect_activate => sub {
+ on_activate => sub {
$CONN ? stop_game
: start_game;
},
);
- $dialog
+ $table->add (0, 12, new CFClient::UI::Label valign => 0, align => 1, text => "Chat Command");
+ $table->add (1, 12, 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 or press \" in the map window. "
+ . "Usually you want to enter something like 'say' or 'shout' or 'gsay' here. "
+ . "But you could also set it to tell playername to only chat with that user.",
+ on_changed => sub {
+ my ($self, $value) = @_;
+ $CFG->{say_command} = $value;
+ }
+ );
+
+ $vbox
}
sub message_window {
my $window = new CFClient::UI::FancyFrame
+ name => "message_window",
title => "Messages",
border_bg => [1, 1, 1, 1],
bg => [0, 0, 0, 0.75],
- user_w => int $::WIDTH / 3,
- user_h => int $::HEIGHT / 5,
+ x => "max",
+ y => 0,
+ force_w => $::WIDTH / 3,
+ force_h => $::HEIGHT / 5,
child => (my $vbox = new CFClient::UI::VBox);
$vbox->add ($LOGVIEW);
@@ -821,7 +864,7 @@
. "from the client setup will be prepended (e.g. shout, chat...). "
. "If you prepend a slash (/), you will submit a command instead (similar to IRC). "
. "A better way to submit commands (and the occasional chat command) is often the map command completer.",
- connect_focus_in => sub {
+ on_focus_in => sub {
my ($input, $prev_focus) = @_;
delete $input->{refocus_map};
@@ -831,7 +874,7 @@
}
delete $input->{auto_activated};
},
- connect_activate => sub {
+ on_activate => sub {
my ($input, $text) = @_;
$input->set_text ('');
@@ -846,14 +889,14 @@
$MAPWIDGET->focus_in
}
},
- connect_escape => sub {
+ on_escape => sub {
$MAPWIDGET->focus_in
},
);
$CONSOLE = {
window => $window,
- input => $input
+ input => $input,
};
$window
@@ -861,8 +904,12 @@
sub open_quit_dialog {
unless ($QUIT_DIALOG) {
-
- $QUIT_DIALOG = new CFClient::UI::FancyFrame title => "Really Quit?";
+ $QUIT_DIALOG = new CFClient::UI::FancyFrame
+ x => "center",
+ y => "center",
+ z => 50,
+ title => "Really Quit?",
+ ;
$QUIT_DIALOG->add (my $vb = new CFClient::UI::VBox expand => 1);
@@ -875,42 +922,219 @@
$hb->add (new CFClient::UI::Button
text => "Ok",
expand => 1,
- connect_activate => sub { $QUIT_DIALOG->hide },
+ on_activate => sub { $QUIT_DIALOG->hide },
);
$hb->add (new CFClient::UI::Button
text => "Quit anyway",
expand => 1,
- connect_activate => sub { exit },
+ on_activate => sub { exit },
);
+ }
- $QUIT_DIALOG->show_centered;
- } else {
- $QUIT_DIALOG->show_centered;
+ $QUIT_DIALOG->show;
+}
+
+sub autopickup_setup {
+ my $table = new CFClient::UI::Table;
+
+ for (
+ ["General", 0, 0,
+ ["Enable autopickup" => PICKUP_NEWMODE],
+ ["Inhibit autopickup" => PICKUP_INHIBIT],
+ ["Stop before pickup" => PICKUP_STOP],
+ ["Debug autopickup" => PICKUP_DEBUG],
+ ],
+ ["Weapons", 0, 6,
+ ["All weapons" => PICKUP_ALLWEAPON],
+ ["Missile weapons" => PICKUP_MISSILEWEAPON],
+ ["Bows" => PICKUP_BOW],
+ ["Arrows" => PICKUP_ARROW],
+ ],
+ ["Armour", 0, 12,
+ ["Helmets" => PICKUP_HELMET],
+ ["Shields" => PICKUP_SHIELD],
+ ["Body Armour" => PICKUP_ARMOUR],
+ ["Boots" => PICKUP_BOOTS],
+ ["Gloves" => PICKUP_GLOVES],
+ ["Cloaks" => PICKUP_CLOAK],
+ ],
+
+ ["Readables", 2, 2,
+ ["Spellbooks" => PICKUP_SPELLBOOK],
+ ["Skillscrolls" => PICKUP_SKILLSCROLL],
+ ["Normal Books/Scrolls" => PICKUP_READABLES],
+ ],
+ ["Misc", 2, 7,
+ ["Food" => PICKUP_FOOD],
+ ["Drinks" => PICKUP_DRINK],
+ ["Valuables (Money, Gems)" => PICKUP_VALUABLES],
+ ["Keys" => PICKUP_KEY],
+ ["Magical Items" => PICKUP_MAGICAL],
+ ["Potions" => PICKUP_POTION],
+ ["Magic Devices" => PICKUP_MAGIC_DEVICE],
+ ["Ignore cursed" => PICKUP_NOT_CURSED],
+ ["Jewelery" => PICKUP_JEWELS],
+ ],
+ )
+ {
+ my ($title, $x, $y, @bits) = @$_;
+ $table->add ($x, $y, new CFClient::UI::Label text => $title, align => 1, fg => [1, 1, 0]);
+
+ for (@bits) {
+ ++$y;
+
+ my $mask = $_->[1];
+ $table->add ($x , $y, new CFClient::UI::Label text => $_->[0], align => 1, expand => 1);
+ $table->add ($x+1, $y, new CFClient::UI::CheckBox
+ state => $CFG->{pickup} & $mask,
+ on_changed => sub {
+ my ($box, $value) = @_;
+ if ($value) {
+ $::CFG->{pickup} |= $mask;
+ } else {
+ $::CFG->{pickup} = $::CFG->{pickup} & ~$mask;
+ }
+ $::CONN->send (sprintf "command pickup %u", $::CFG->{pickup})
+ if defined $::CONN;
+ });
+ }
}
+
+ $table
}
sub make_inventory_window {
- my $invwin = new CFClient::UI::FancyFrame
- user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Inventory";
+ my $invwin = $INV_WINDOW = new CFClient::UI::FancyFrame
+ x => "center",
+ y => "center",
+ force_w => $WIDTH * 9/10,
+ force_h => $HEIGHT * 9/10,
+ title => "Inventory",
+ ;
+
+ $invwin->add (my $hb = new CFClient::UI::HBox homogeneous => 1);
+
+ $hb->add (my $vb1 = new CFClient::UI::VBox);
+ $vb1->add (new CFClient::UI::Label align => 0, text => "Player");
+ $vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
- $invwin->add (my $hb = new CFClient::UI::HBox expand => 1);
+ $hb->add (my $vb2 = new CFClient::UI::VBox);
+
+ $vb2->add ($INV_RIGHT_HB = new CFClient::UI::HBox);
- $hb->add (my $vb1 = new CFClient::UI::VBox expand => 1);
- $vb1->add (my $lbl = new CFClient::UI::Label xalign => 0.5);
- $lbl->set_text ("Player");
- $vb1->add ($INV = new CFClient::UI::Inventory expand => 1);
-
- $hb->add (my $vb2 = new CFClient::UI::VBox expand => 1);
- $vb2->add ($INVR_LBL = new CFClient::UI::Label xalign => 0.5);
- $INVR_LBL->set_text ("Floor");
$vb2->add ($INVR = new CFClient::UI::Inventory expand => 1);
+ # XXX: Call after $INVR = ... because set_opencont sets the items
+ CFClient::Protocol::set_opencont ($::CONN, 0, "Floor");
+
$invwin
}
+sub spell_setup {
+ new CFClient::UI::SpellList
+}
+
+sub keyboard_setup {
+ my $binding_list = new CFClient::UI::VBox;
+
+ my $refresh;
+ $refresh = sub {
+ $binding_list->clear ();
+
+ for my $mod (keys %{$::CFG->{bindings}}) {
+ for my $sym (keys %{$::CFG->{bindings}->{$mod}}) {
+ my $cmds = $::CFG->{bindings}->{$mod}->{$sym};
+ next unless ref $cmds eq 'ARRAY' and @$cmds > 0;
+
+ my $lbl = join "; ", @$cmds;
+ my $nam = CFClient::Binder::keycombo_to_name ($mod, $sym);
+ $binding_list->add (my $hb = new CFClient::UI::HBox);
+ $hb->add (new CFClient::UI::Button
+ text => "delete",
+ tooltip => "Deletes the binding",
+ on_activate => sub {
+ $binding_list->remove ($hb);
+ delete $::CFG->{bindings}->{$mod}->{$sym};
+ });
+
+ $hb->add (new CFClient::UI::Button
+ text => "edit",
+ tooltip => "Edits the binding",
+ on_activate => sub {
+ $::BIND_EDITOR->set_binding (
+ $mod, $sym, $::CFG->{bindings}->{$mod}->{$sym},
+ sub {
+ my ($nmod, $nsym, $ncmds) = @_;
+ delete $::CFG->{bindings}->{$mod}->{$sym};
+ $::CFG->{bindings}->{$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;
+ });
+
+ $hb->add (new CFClient::UI::Label text => "(Key: $nam)");
+ $hb->add (new CFClient::UI::Label text => $lbl, expand => 1);
+ }
+ }
+ };
+
+ my $vb = new CFClient::UI::VBox;
+ $vb->add ($binding_list);
+ $vb->add (my $hb = new CFClient::UI::HBox);
+
+ $hb->add (new CFClient::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) = @_;
+ $::CFG->{bindings}->{$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;
+ },
+ );
+
+ $hb->add (new CFClient::UI::Button
+ text => "close",
+ tooltip => "Closes the binding window",
+ expand => 1,
+ on_activate => sub {
+ $SETUP_DIALOG->hide;
+ }
+ );
+
+ $refresh->();
+
+ $vb
+}
+
sub make_help_window {
my $win = new CFClient::UI::FancyFrame
- user_w => $WIDTH * (7/8), user_h => $HEIGHT * (7/8), title => "Documentation";
+ x => 'center',
+ y => 'center',
+ z => 2,
+ name => 'doc_browser',
+ force_w => int $WIDTH * 7/8,
+ force_h => int $HEIGHT * 7/8,
+ title => "Documentation";
$win->add (my $vbox = new CFClient::UI::VBox);
@@ -927,14 +1151,14 @@
$buttons->add (new CFClient::UI::Button
text => $label,
- connect_activate => sub {
- my $parser = new Pod::POM;
- my $pom = $parser->parse_file (CFClient::find_rcfile "pod/$pod.pod");
+ on_activate => sub {
+ my $pom = CFClient::load_pod CFClient::find_rcfile "pod/$pod.pod",
+ doc_viewer => 1, sub { CFClient::pod_to_pango_list $_[0] };
$viewer->clear;
$viewer->add_paragraph ([1, 1, 1, 1], $_->[1], $_->[0])
- for @{ CFClient::pod_to_pango_list $pom };
+ for @$pom;
$viewer->set_offset (0);
},
@@ -968,7 +1192,7 @@
$SDL_ACTIVE = 1;
$LAST_REFRESH = time - 0.01;
- CFClient::gl_init;
+ CFClient::OpenGL::init;
$FONTSIZE = int $HEIGHT / 40 * $CFG->{gui_fontsize};
@@ -981,19 +1205,30 @@
} else {
# create the widgets
- $DEBUG_STATUS = new CFClient::UI::Label padding => 0, z => 100, req_x => -1;
+ $DEBUG_STATUS = new CFClient::UI::Label
+ padding => 0,
+ z => 100,
+ force_x => "max",
+ force_y => 0;
$DEBUG_STATUS->show;
-
+
+ $BIND_EDITOR = new CFClient::UI::BindEditor (x => "max", y => 0);
+
$STATUSBOX = new CFClient::UI::Statusbox;
- $STATUSBOX->add ("Use Alt-Enter to toggle fullscreen mode", pri => -100, color => [1, 1, 1, 0.8]);
+ $STATUSBOX->add ("Use Alt-Enter to toggle fullscreen mode", timeout => 864000, pri => -100, color => [1, 1, 1, 0.8]);
(new CFClient::UI::Frame
bg => [0, 0, 0, 0.4],
- req_y => -1,
+ force_x => 0,
+ force_y => "max",
child => $STATUSBOX,
)->show;
CFClient::UI::FancyFrame->new (
+ title => "Map",
+ name => "mapmap",
+ x => 0,
+ y => $FONTSIZE + 8,
border_bg => [1, 1, 1, 192/255],
bg => [1, 1, 1, 0],
child => ($MAPMAP = new CFClient::MapWidget::MapMap
@@ -1026,12 +1261,42 @@
tooltip => "Server Log. This text viewer contains all the messages sent by the server.",
;
- $BUTTONBAR = new CFClient::UI::HBox;
+ $SETUP_DIALOG = new CFClient::UI::FancyFrame
+ title => "Setup",
+ name => "setup_dialog",
+ x => 'center',
+ y => 'center',
+ z => 2,
+ force_w => $::WIDTH * 0.6,
+ force_h => $::HEIGHT * 0.6,
+ ;
+
+ $SETUP_DIALOG->add ($SETUP_NOTEBOOK = new CFClient::UI::Notebook expand => 1, debug => 1,
+ filter => new CFClient::UI::ScrolledWindow xxx => 1, expand => 1, scroll_y => 1);
+
+ $SETUP_NOTEBOOK->add (Server => $SETUP_SERVER = server_setup,
+ "Configure the server to play on, your username, password and other server-related options.");
+ $SETUP_NOTEBOOK->add (Pickup => autopickup_setup,
+ "Configure autopickup settings, i.e. which items you will pick up automatically when walking (or running) over them.");
+ $SETUP_NOTEBOOK->add (Graphics => graphics_setup,
+ "Configure the video mode, performance, fonts and other graphical aspects of the game.");
+ $SETUP_NOTEBOOK->add (Audio => audio_setup,
+ "Configure the use of audio, sound effects and background music.");
+ $SETUP_NOTEBOOK->add (Keyboard => $SETUP_KEYBOARD = keyboard_setup,
+ "Lets you define, edit and delete bindings."
+ . "There is a shortcut for making bindings: Left Control + Insert opens the binding editor "
+ . "with nothing set and the recording started. After doing the actions you "
+ . "want to record press Insert and you will be asked to press a key-combo. "
+ . "After pressing the combo the binding will be saved automatically and the "
+ . "binding editor closes");
+ $SETUP_NOTEBOOK->add (Spells => $SETUP_SPELLS = spell_setup,
+ "Displays all spells you have and lets you edit keyboard shortcuts for them.");
+
+ $BUTTONBAR = new CFClient::UI::Buttonbar x => 0, y => 0, z => 200; # put on top
+
+ $BUTTONBAR->add (new CFClient::UI::Flopper text => "Setup", other => $SETUP_DIALOG,
+ tooltip => "Toggles a dialog where you can configure all aspects of this client.");
- $BUTTONBAR->add (new CFClient::UI::Flopper text => "Client Setup", other => client_setup,
- tooltip => "Toggles a dialog where you can configure various aspects of the client, such as graphics mode, performance, and audio options.");
- $BUTTONBAR->add (new CFClient::UI::Flopper text => "Server Setup", other => server_setup,
- tooltip => "Toggles a dialog where you can configure the server to play on, your username, password and other server-related options.");
$BUTTONBAR->add (new CFClient::UI::Flopper text => "Message Window", other => message_window,
tooltip => "Toggles the server message log, where the client collects all messages from the server.");
@@ -1040,13 +1305,15 @@
$BUTTONBAR->add (new CFClient::UI::Flopper text => "Stats Window", other => make_stats_window,
tooltip => "Toggles the statistics window, where all your Stats and Resistances are being displayed at all times.");
$BUTTONBAR->add (new CFClient::UI::Flopper text => "Inventory", other => make_inventory_window,
- tooltip => "Toggles the inventory window, where you can manage your loot (or treaures :).");
+ tooltip => "Toggles the inventory window, where you can manage your loot (or treasures :). "
+ . "You can also hit the Tab-key to show/hide the Inventory.");
$BUTTONBAR->add (new CFClient::UI::Button
text => "Save Config",
tooltip => "Saves the options chosen in the client setting, server settings and the window layout to be restored on later runs.",
- connect_activate => sub {
- CFClient::write_cfg "$Crossfire::VARDIR/pclientrc";
+ on_activate => sub {
+ $::CFG->{layout} = CFClient::UI::get_layout;
+ CFClient::write_cfg "$Crossfire::VARDIR/cfplusrc";
status "Configuration Saved";
},
);
@@ -1055,9 +1322,9 @@
tooltip => "View Documentation");
$BUTTONBAR->add (new CFClient::UI::Button
- text => "Quit",
- tooltip => "Terminates the program",
- connect_activate => sub {
+ text => "Quit",
+ tooltip => "Terminates the program",
+ on_activate => sub {
if ($CONN) {
open_quit_dialog;
} else {
@@ -1067,17 +1334,10 @@
);
$BUTTONBAR->show;
-
- $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
-
- # delay till geometry is constant
- $CFClient::UI::ROOT->on_post_alloc (startup => sub {
- $BUTTONBAR->{children}[1]->emit ("activate"); # pop up server setup
- my $widget = $GAUGES->{win};
- $widget->move (0, $HEIGHT - $widget->{h});#d# to in toplevel
- });
- force_refresh ();
+ $SETUP_DIALOG->show;
}
+
+ $STATUSBOX->add ("Set video mode $WIDTH×$HEIGHT", timeout => 10, fg => [1, 1, 1, 0.5]);
}
sub video_shutdown {
@@ -1154,7 +1414,7 @@
sub force_refresh {
$fps = $fps * 0.95 + 1 / (($NOW - $LAST_REFRESH) || 0.1) * 0.05;
- debug sprintf "%3.2f", $fps;
+ debug sprintf "%3.2f", $fps if $ENV{CFPLUS_DEBUG} & 4;
$CFClient::UI::ROOT->draw;
@@ -1219,7 +1479,7 @@
CFClient::SDL_GL_SwapBuffers;
}
-my $refresh_watcher = Event->timer (after => 0, hard => 1, interval => 1 / $MAX_FPS, cb => sub {
+my $refresh_watcher = Event->timer (after => 0, hard => 0, interval => 1 / $MAX_FPS, cb => sub {
$NOW = time;
($SDL_CB{$_->{type}} || sub { warn "unhandled event $_->{type}" })->($_)
@@ -1247,502 +1507,6 @@
delete $animate_object{$widget};
}
-@conn::ISA = Crossfire::Protocol::;
-
-sub conn::new {
- my $class = shift;
-
- my $self = $class->Crossfire::Protocol::new (@_);
-
- $MAPWIDGET->clr_commands;
-
- my $parser = new Pod::POM;
- my $pod = $parser->parse_file (CFClient::find_rcfile "pod/command_help.pod");
-
- for my $head2 ($pod->head2) {
- $head2->title =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x
- or next;
-
- my $cmd = $1;
- my @args = split /\|/, $2;
- @args = (".*") unless @args;
-
- my $text = CFClient::pod_to_pango $head2->content;
-
- for my $arg (@args) {
- $arg = $arg eq ".*" ? "" : " $arg";
-
- $MAPWIDGET->add_command ("$cmd$arg", $text);
- }
- }
-
- $self->{noface} = new_from_file CFClient::Texture
- CFClient::find_rcfile "noface.png", minify => 1, mipmap => 1;
-
- $self->{open_container} = 0;
-
- $self
-}
-
-sub conn::stats_update {
- my ($self, $stats) = @_;
-
- if (my $exp = $stats->{Crossfire::Protocol::CS_STAT_EXP64}) {
- my $diff = $exp - $self->{prev_exp};
- $STATUSBOX->add ("$diff experience gained", group => "experience $diff", fg => [0.5, 1, 0.5, 0.8], timeout => 5)
- if exists $self->{prev_exp} && $diff;
- $self->{prev_exp} = $exp;
- }
-
- 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);
- }
- }
-}
-
-# hardcode /world/world_xxx_xxx map names, the savings are enourmous,
-# (server resource,s latency, bandwidth), so this hack is warranted.
-# the right fix is to make real tiled maps with an overview file
-sub conn::send_mapinfo {
- my ($self, $data, $cb) = @_;
-
- if ($self->{map_info}[0] =~ m%^/world/world_(\d\d\d)_(\d\d\d)$%) {
- my ($wx, $wy) = ($1, $2);
-
- if ($data =~ /^spatial ([1-4]+)$/) {
- my @dx = (0, 0, 1, 0, -1);
- my @dy = (0, -1, 0, 1, 0);
- my ($dx, $dy);
-
- for (split //, $1) {
- $dx += $dx[$_];
- $dy += $dy[$_];
- }
-
- $cb->(spatial => 15,
- $self->{map_info}[1] - $MAP->ox + $dx * 50,
- $self->{map_info}[2] - $MAP->oy + $dy * 50,
- 50, 50,
- sprintf "/world/world_%03d_%03d", $wx + $dx, $wy + $dy
- );
-
- return;
- }
- }
-
- $self->Crossfire::Protocol::send_mapinfo ($data, $cb);
-}
-
-# 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, $block, $gx, $gy, $path, $hash, $flags) = @_;
-
- # the server does not allow map paths > 6
- return if 7 <= length $path;
-
- my ($x0, $y0, $x1, $y1) = @{$self->{neigh_rect}};
-
- for (
- [1, 3, 0, -1],
- [2, 4, 1, 0],
- [3, 1, 0, 1],
- [4, 2, -1, 0],
- ) {
- my ($tile, $tile2, $dx, $dy) = @$_;
-
- next if $block & (1 << $tile);
- my $block = $block | (1 << $tile2);
-
- 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 ($block, $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 ($block, $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 = $MAPMAP->{w};
- my $mapmaph = $MAPMAP->{h};
-
- $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};
-
- $x += $ox;
- $y += $oy;
-
- $self->{map_info} = [$hash, $x, $y, $w, $h];
-
- (my $map = $hash) =~ s/^.*?\/([^\/]+)$/\1/;
- $STATWIDS->{map}->set_text ("Map: " . $map);
-
- $self->load_map ($hash, $x, $y);
- $self->flood_fill (0, 0, 0, "", $hash, $flags);
-}
-
-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 = ($id || 16) + 1;
- 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#
-
- my $face = $TILECACHE->get ($id);
-
- if ($face) {
- #$self->face_prefetch;
- $face
- } else {
- my $tex = $self->{noface};
- $MAP->set_texture ($id, @$tex{qw(name w h s t)}, @{$tex->{minified}});
- undef
- };
-}
-
-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,
- ellipsise => 0,
- 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;
- },
- );
-
- $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;
- },
- );
-
- $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;
- },
- );
-
- $entry->focus_in;
- }
-
- $dialog->show_centered;
-}
-
-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],
- );
-
- my $time = sprintf "%02d:%02d:%02d", (localtime time)[2,1,0];
-
- $text = CFClient::UI::Label::escape $text;
- $text =~ s/\[b\](.*?)\[\/b\]/\1<\/b>/g;
- $text =~ s/\[color=(.*?)\](.*?)\[\/color\]/\2<\/span>/g;
-
- $LOGVIEW->add_paragraph ($color[$color],
- join "\n", map "$time $_", split /\n/, $text);
-
- $STATUSBOX->add ($text,
- group => $text,
- fg => $color[$color],
- timeout => 10,
- tooltip_font => $::FONT_FIXED,
- );
-}
-
-sub conn::drawextinfo {
- my ($self, $color, $type, $subtype, $message) = @_;
-
- $self->drawinfo ($color, $message);
-}
-
-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}", CFClient::UI::Label::escape $spell->{message});
- $MAPWIDGET->add_command ("cast $spell->{name}", CFClient::UI::Label::escape $spell->{message});
-}
-
-sub conn::spell_delete {
- my ($self, $spell) = @_;
-}
-
-sub conn::addme_success {
- my ($self) = @_;
-
- $self->send ("command output-sync $CFG->{output_sync}");
- $self->send ("command output-count $CFG->{output_count}");
-
- my $parser = new Pod::POM;
- my $pod = $parser->parse_file (CFClient::find_rcfile "pod/skill_help.pod");
-
- my %skill_tooltip;
-
- for my $head2 ($pod->head2) {
- $skill_tooltip{$head2->title} = CFClient::pod_to_pango $head2->content;
- }
-
- for my $skill (values %{$self->{skill_info}}) {
- $MAPWIDGET->add_command ("ready_skill $skill",
- (CFClient::UI::Label::escape "Ready the skill '$skill'\n\n")
- . $skill_tooltip{$skill});
- $MAPWIDGET->add_command ("use_skill $skill",
- (CFClient::UI::Label::escape "Immediately use the skill '$skill'\n\n")
- . $skill_tooltip{$skill});
- }
-}
-
-sub conn::eof {
- $MAPWIDGET->clr_commands;
-
- stop_game;
-}
-
-sub conn::image_info {
- my ($self, $numfaces) = @_;
-
- $self->{num_faces} = $numfaces;
- $self->{face_prefetch} = [1 .. $numfaces];
- $self->face_prefetch;
-}
-
-sub conn::face_prefetch {
- my ($self) = @_;
-
- return unless $CFG->{face_prefetch};
-
- if ($self->{num_faces}) {
- return if @{ $self->{send_queue} || [] };
- my $todo = @{ $self->{face_prefetch} }
- or return;
-
- my ($face) = splice @{ $self->{face_prefetch} }, + rand @{ $self->{face_prefetch} }, 1, ();
-
- $self->send ("requestinfo image_sums $face $face");
-
- $STATUSBOX->add (CFClient::UI::Label::escape "prefetching $todo",
- group => "prefetch", timeout => 2, fg => [1, 1, 0, 0.5]);
- } elsif (!exists $self->{num_faces}) {
- $self->send ("requestinfo image_info");
-
- $self->{num_faces} = 0;
-
- $STATUSBOX->add (CFClient::UI::Label::escape "starting to prefetch",
- group => "prefetch", timeout => 2, fg => [1, 1, 0, 0.5]);
- }
-}
-
# check once/second for faces that need to be prefetched
# this should, of course, only run on demand, but
# SDL forces worse things on us....
@@ -1752,123 +1516,6 @@
if $CONN;
});
-sub update_floorbox {
- $CFClient::UI::ROOT->on_refresh ($FLOORBOX => sub {
- return unless $CONN;
-
- $FLOORBOX->clear;
-
- my $row;
- for (@{ $CONN->{container}{0} }) {
- if ($row < 7) {
- local $_->{face_widget}; # hack to force recreation of widget
- local $_->{desc_widget}; # hack to force recreation of widget
- CFClient::Item::update_widgets $_;
-
- $FLOORBOX->add (0, $row, $_->{face_widget});
- $FLOORBOX->add (1, $row, $_->{desc_widget});
-
- $row++;
- } else {
- $FLOORBOX->add (1, $row, new CFClient::UI::Label text => "More...");
- last;
- }
- }
- });
-
- $WANT_REFRESH++;
-}
-
-sub set_opencont {
- my ($conn, $tag, $name) = @_;
- $conn->{open_container} = $tag;
- $INVR_LBL->set_text ($name);
- $INVR->set_items ($conn->{container}{$tag});
-}
-
-sub update_container {
- my ($tag) = @_;
- $INVR->set_items ($::CONN->{container}{$CONN->{open_container}})
- if $tag == $CONN->{open_container};
-}
-
-sub conn::container_add {
- my ($self, $tag, $items) = @_;
-
- #d# print "container_add: container $tag ($self->{player}{tag})\n";
-
- if ($tag == 0) {
- update_floorbox;
- update_container (0);
- } elsif ($tag == $self->{player}{tag}) {
- $INV->set_items ($self->{container}{$self->{player}{tag}})
- } else {
- update_container ($tag);
- }
-
- # $self-<{player}{tag} => player inv
- #use PApp::Util; warn PApp::Util::dumpval $self->{container}{$self->{player}{tag}};
-}
-
-sub conn::container_clear {
- my ($self, $tag) = @_;
-
- #d# print "container_clear: container $tag ($self->{player}{tag})\n";
-
- if ($tag == 0) {
- update_floorbox;
- update_container (0);
- } elsif ($tag == $self->{player}{tag}) {
- $INV->set_items ($self->{container}{$tag})
- }
-
-# use PApp::Util; warn PApp::Util::dumpval $self->{container}{0};
-}
-
-sub conn::item_delete {
- my ($self, @items) = @_;
-
- for (@items) {
- #d# print "item_delete: $_->{tag} from $_->{container} ($self->{player}{tag})\n";
-
- if ($_->{container} == 0) {
- update_floorbox;
- update_container ($_->{tag});
- } elsif ($_->{container} == $self->{player}{tag}) {
- $INV->set_items ($self->{container}{$self->{player}{tag}})
- } else {
- update_container ($_->{tag});
- }
- }
-}
-
-sub conn::item_update {
- my ($self, $item) = @_;
-
- #d# print "item_update: $item->{tag} in $item->{container} ($self->{player}{tag}) ($CONN->{open_container})\n";
-
- if ($item->{tag} == $self->{player}{tag}) {
- $STATWIDS->{weight}->set_text (sprintf "Weight: %.1fkg", $item->{weight} / 1000);
- return
- }
-
- CFClient::Item::update_widgets $item;
-
- if ($item->{tag} == $CONN->{open_container} && not ($item->{flags} & Crossfire::Protocol::F_OPEN)) {
- set_opencont ($CONN, 0, "Floor");
-
- } elsif ($item->{flags} & Crossfire::Protocol::F_OPEN) {
- set_opencont ($CONN, $item->{tag}, CFClient::Item::desc_string $item);
- } else {
- if ($item->{container} == 0) {
- update_floorbox;
- update_container (0);
- } elsif ($item->{container} == $self->{player}{tag}) {
- $INV->set_items ($self->{container}{$item->{container}})
- }
- }
-}
-
%SDL_CB = (
CFClient::SDL_QUIT => sub {
Event::unloop -1;
@@ -1909,12 +1556,14 @@
$SIG{INT} = $SIG{TERM} = sub { exit };
{
- local $SIG{__DIE__} = sub { CFClient::fatal $_[0] };
-
- CFClient::read_cfg "$Crossfire::VARDIR/pclientrc";
+ local $SIG{__DIE__} = sub {
+ return unless defined $^S && !$^S;
+ Carp::confess $_[1];#d#TODO: remove when stable
+ CFClient::fatal $_[0];
+ };
- $TILECACHE = CFClient::db_table "tilecache";
- $FACEMAP = CFClient::db_table "facemap";
+ CFClient::read_cfg "$Crossfire::VARDIR/cfplusrc";
+ CFClient::UI::set_layout ($::CFG->{layout});
my %DEF_CFG = (
sdl_mode => 0,
@@ -2001,7 +1650,7 @@
=head1 NAME
-pclient - A Crossfire+ and Crossfire game client
+cfplus - A Crossfire+ and Crossfire game client
=head1 SYNOPSIS
@@ -2009,9 +1658,19 @@
=head1 USAGE
-Pclient utilises OpenGL for all UI elements and the game. It is supposed to be used
+cfplus utilises OpenGL for all UI elements and the game. It is supposed to be used
fullscreen and interactively.
+=head1 DEBUGGING
+
+
+CFPLUS_DEBUG - environment variable
+
+ 1 draw borders around widgets
+ 2 add low-level widget info to tooltips
+ 4 show fps
+ 8 suppress tooltips
+
=head1 AUTHOR
Marc Lehmann , Robin Redeker