--- deliantra/Deliantra-Client/DC/Protocol.pm 2008/05/05 20:22:03 1.194
+++ deliantra/Deliantra-Client/DC/Protocol.pm 2010/04/08 19:11:21 1.218
@@ -1,7 +1,8 @@
package DC::Protocol;
-use utf8;
-use strict;
+use common::sense;
+
+use Guard ();
use Deliantra::Protocol::Constants;
@@ -14,6 +15,14 @@
use base 'Deliantra::Protocol::Base';
+our $TEX_DIALOGUE = new_from_resource DC::Texture
+ "dialogue.png", minify => 1, mipmap => 1;
+
+our $TEX_NOFACE = new_from_resource DC::Texture
+ "noface.png", minify => 1, mipmap => 1, wrap => 1;
+
+sub MIN_TEXTURE_UNUSED() { 1 }#d#
+
sub new {
my ($class, %arg) = @_;
@@ -66,23 +75,42 @@
$_->destroy
for values %{delete $ws->{w} || {}};
}
+
+ delete $self->{items};
+ $::INV->clear;
+ $::INVR->clear;
+ $::INVR_HB->clear;
+ $::FLOORBOX->clear;
});
$self->{map_widget}->add_command (@$_)
for @cmd_help;
{
- $self->{dialogue} = my $tex = new_from_file DC::Texture
- DC::find_rcfile "dialogue.png", minify => 1, mipmap => 1;
+ $self->{dialogue} = my $tex = $TEX_DIALOGUE;
$self->{map}->set_texture (1, @$tex{qw(name w h s t)}, @{$tex->{minified}});
}
{
- $self->{noface} = my $tex = new_from_file DC::Texture
- DC::find_rcfile "noface.png", minify => 1, mipmap => 1;
+ $self->{noface} = my $tex = $TEX_NOFACE;
$self->{map}->set_texture (2, @$tex{qw(name w h s t)}, @{$tex->{minified}});
}
+# $self->{expire_count} = DC::DB::FIRST_TILE_ID; # minimum non-fixed tile id
+# $self->{expire_w} = EV::timer 1, 1, sub {
+# my $count = (int @{ $self->{texture} } / MIN_TEXTURE_UNUSED) || 1;
+#
+# for ($self->{map}->expire_textures ($self->{expire_count}, $count)) {
+# warn DC::SvREFCNT $self->{texture}[$_];
+# $self->{texture}[$_]->unload;
+# warn "expire texture $_\n";#d#
+# }
+#
+# ($self->{expire_count} += $count) < @{ $self->{texture} }
+# or $self->{expire_count} = DC::DB::FIRST_TILE_ID;
+# warn "count is $count\n";#d#
+# };
+
$self->{open_container} = 0;
# per server
@@ -252,6 +280,9 @@
tooltip => $DC::UI::TOOLTIP,
mapwidget => $::MAPWIDGET,
+ menubar => $::MENUBAR,
+ menupopup => $::MENUPOPUP,
+ pickup_enable => $::PICKUP_ENABLE,
buttonbar => $::BUTTONBAR,
metaserver => $::METASERVER,
buttonbar => $::BUTTONBAR,
@@ -278,7 +309,7 @@
help_window => $::HELP_WINDOW,
message_window => $::MESSAGE_WINDOW,
message_dist => $::MESSAGE_DIST,
- statusbox => $::SDTATUSBOX,
+ statusbox => $::STATUSBOX,
inv => $::INV,
invr => $::INVR,
@@ -372,7 +403,7 @@
}
sort { $a <=> $b } keys %{$self->{spell_paths}};
- join "", @diff
+ "\u$name: " . (join ", ", @diff)
}
# all stats that are chacked against changes
@@ -437,7 +468,7 @@
if (
my @diffs = map $_->[1]->($self, $_->[2], $prev->{$_->[0]}, $stats->{$_->[0]}), @statchange
) {
- my $msg = "stat change: " . (join " ", @diffs);
+ my $msg = "stat change: " . (join " ", map "($_)", @diffs);
$self->{statusbox}->add ($msg, group => "stat $msg", fg => [0.8, 1, 0.2, 1], timeout => 20);
}
@@ -485,9 +516,9 @@
$::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->{+CS_STAT_EXP64}))
- . " (lvl " . ($stats->{+CS_STAT_LEVEL} * 1) . ")");
- $::GAUGES->{prg} ->set_value ($stats->{+CS_STAT_LEVEL}, $stats->{+CS_STAT_EXP64});
+ $::GAUGES->{exp} ->set_label ("Exp: " . (::formsep ($stats->{+CS_STAT_EXP64}))#d#
+ . " (lvl " . ($stats->{+CS_STAT_LEVEL} * 1) . ")");
+ $::GAUGES->{exp} ->set_value ($stats->{+CS_STAT_LEVEL}, $stats->{+CS_STAT_EXP64});
$::GAUGES->{range} ->set_text ($stats->{+CS_STAT_RANGE});
my $title = $stats->{+CS_STAT_TITLE};
$title =~ s/^Player: //;
@@ -509,7 +540,7 @@
$self->update_weight;
- $::STATWIDS->{"res_$_"}->set_text (sprintf "%d%", $stats->{$RES_TBL{$_}})
+ $::STATWIDS->{"res_$_"}->set_text (sprintf "%d%%", $stats->{$RES_TBL{$_}})
for keys %RES_TBL;
my $sktbl = $::STATWIDS->{skill_tbl};
@@ -538,7 +569,7 @@
my @add = @$sw;
- my $TOOLTIP_ALL = "\n\nLeft click - ready skill\nMiddle click - use spell\nRight click - further options";
+ my $TOOLTIP_ALL = "\n\nLeft click - ready skill\nMiddle click - use skill\nRight click - further options";
my @TOOLTIP_LVL = (tooltip => "Level. The level of the skill.$TOOLTIP_ALL", can_events => 1, can_hover => 1);
my @TOOLTIP_EXP = (tooltip => "Experience. The experience points you have in this skill.$TOOLTIP_ALL", can_events => 1, can_hover => 1);
@@ -610,8 +641,8 @@
$sw->[1]->set_text ($val->[0] * 1);
$sw->[2]->set_value (@$val);
- $::GAUGES->{sklprg}->set_label ("$name %d%%");
- $::GAUGES->{sklprg}->set_value (@$val);
+ $::GAUGES->{skillexp}->set_label ("$name %d%%");
+ $::GAUGES->{skillexp}->set_value (@$val);
}
}
@@ -634,7 +665,7 @@
sub map_scroll {
my ($self, $dx, $dy) = @_;
- $self->{map}->scroll ($dx, $dy);
+ $self->{map_widget}->scroll ($dx, $dy);
}
sub feed_map1a {
@@ -648,12 +679,12 @@
$delay = 1;
- if (my $tex = $::CONN->{texture}[$tile]) {
+ if (my $tex = $self->{texture}[$tile]) {
$tex->upload;
} else {
$self->{delay}{$tile} = 1;
- # we assume the face is in-flight and will eventually come
+ # we assume the face is in-flight and will eventually arrive
push @{$self->{tile_cb}{$tile}}, sub {
delete $self->{delay}{$tile};
$_[0]->upload;
@@ -662,7 +693,7 @@
}
if ($delay) {
- # delay the map drawing a tiny bit in the hope of getting the missing fetched
+ # delay the map drawing a tiny bit in the hope of getting the missing tiles fetched
EV::once undef, 0, 0.03, sub {
$self->{map_widget}->update
if $self->{map_widget};
@@ -681,20 +712,26 @@
sub flush_map {
my ($self) = @_;
- my $map_info = delete $self->{map_info}
- or return;
+ return unless $self->{map_info};
+
+ for my $map_info (values %{ $self->{map_cache} || {} }) {
+ my ($hash, $rdata, $x, $y, $w, $h) = @$map_info;
- my ($hash, $x, $y, $w, $h) = @$map_info;
+ my $data = $self->{map}->get_rect ($x, $y, $w, $h);
- my $data = Compress::LZF::compress $self->{map}->get_rect ($x, $y, $w, $h);
- $self->{map_cache_new}{$hash} = \$data;
- DC::DB::put $self->{mapcache} => $hash => $data, sub { };
+ if ($data ne $$rdata) {
+ $map_info->[1] = \$data;
+ my $cdata = Compress::LZF::compress $data;
+ DC::DB::put $self->{mapcache} => $hash => $cdata, sub { };
+ }
+ }
}
sub map_clear {
my ($self) = @_;
$self->flush_map;
+ delete $self->{map_info};
delete $self->{neigh_map};
$self->{map}->clear;
@@ -725,36 +762,34 @@
};
}
-sub load_map($$$) {
- my ($self, $hash, $x, $y) = @_;
+sub load_map($$$$$$) {
+ my ($self, $hash, $x, $y, $w, $h) = @_;
- my $gen = $self->{map_change_gen};
+ my $map_info = $self->{map_cache}{$hash} = [$hash, \"", $x, $y, $w, $h];
my $cb = sub {
- return unless $gen == $self->{map_change_gen};
-
- my ($data) = @_;
+ $map_info->[1] = \$_[0];
- if (defined $data) {
- $self->{map_cache_new}{$hash} = \$data;
-
- my $data = Compress::LZF::decompress $data;
-
- my $inprogress = @{ $self->{bg_fetch} || [] };
- unshift @{ $self->{bg_fetch} }, $self->{map}->set_rect ($x, $y, $data);
- $self->bg_fetch unless $inprogress;
- }
+ my $inprogress = @{ $self->{bg_fetch} || [] };
+ unshift @{ $self->{bg_fetch} }, $self->{map}->set_rect ($x, $y, $_[0]);
+ $self->bg_fetch unless $inprogress;
};
- if (my $rdata = $self->{map_cache_old}{$hash}) {
- $cb->($$rdata);
+ if (my $map_info = $self->{map_cache_old}{$hash}) {
+ $cb->(${ $map_info->[1] });
} else {
- DC::DB::get $self->{mapcache} => $hash, $cb;
+ my $gen = $self->{map_change_gen};
+
+ DC::DB::get $self->{mapcache} => $hash, sub {
+ return unless $gen == $self->{map_change_gen};
+ return unless defined $_[0];
+ $cb->(Compress::LZF::decompress $_[0]);
+ };
}
}
# hardcode /world/world_xxx_xxx map names, the savings are enourmous,
-# (server resource,s latency, bandwidth), so this hack is warranted.
+# (server resources, latency, bandwidth), so this hack is warranted.
# the right fix is to make real tiled maps with an overview file
sub send_mapinfo {
my ($self, $data, $cb) = @_;
@@ -789,7 +824,7 @@
# 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
+# failure to comply is harmless and results in display errors
# at worst.
sub flood_fill {
my ($self, $block, $gx, $gy, $path, $hash, $flags) = @_;
@@ -835,7 +870,7 @@
$x += $self->{map}->ox;
$y += $self->{map}->oy;
- $self->load_map ($hash, $x, $y)
+ $self->load_map ($hash, $x, $y, $w, $h)
unless $self->{neigh_map}{$hash}[5]++;#d#
$neigh->[$tile] = [$flags, $x, $y, $w, $h, $hash];
@@ -853,7 +888,7 @@
$self->flush_map;
++$self->{map_change_gen};
- $self->{map_cache_old} = delete $self->{map_cache_new};
+ $self->{map_cache_old} = delete $self->{map_cache};
my ($ox, $oy) = ($::MAP->ox, $::MAP->oy);
@@ -875,7 +910,7 @@
(my $map = $hash) =~ s/^.*?\/([^\/]+)$/\1/;
$::STATWIDS->{map}->set_text ("Map: " . $map);
- $self->load_map ($hash, $x, $y);
+ $self->load_map ($hash, $x, $y, $w, $h);
$self->flood_fill (0, 0, 0, "", $hash, $flags);
}
@@ -956,7 +991,7 @@
new DC::Texture
tile => $tile,
image => $data, delete_image => 1,
- minify => 1, mipmap => 1;
+ minify => 1;
if (my $cbs = delete $self->{tile_cb}{$tile}) {
$_->($tex) for @$cbs;
@@ -971,7 +1006,7 @@
push @{$self->{face_cb}{$num}}, $cb;
defined wantarray
- ? DC::guard {
+ ? Guard::guard {
@{$self->{face_cb}{$num}}
= grep $_ != $cb,
@{$self->{face_cb}{$num}};
@@ -1028,6 +1063,8 @@
s/(.*?)<\/fg>/$2<\/span>/gs;
s/(.*?)<\/fg>/$2<\/span>/gs;
+ s/\s+$//;
+
$_
}
@@ -1083,21 +1120,19 @@
# no longer neecssary with TRT servers
#$text =~ s/(?<=\S)\n(?=\w)/ /g;
- for (split /\n/, $text) {
- ::message ({
- fg => $fg,
- markup => $_,
- type => $type,
- extra => [@extra],
- color_flags => $color, #d# ugly, kill
- });
+ ::message ({
+ fg => $fg,
+ markup => $text,
+ type => $type,
+ extra => [@extra],
+ color_flags => $color, #d# ugly, kill
+ });
- $color &= ~NDI_CLEAR; # only clear once for multiline messages
- # actually, this is an ugly design. _we_ should control the channels,
- # not some random other widget, as the channels are clearly protocol-specific.
- # then we could also react to flags such as CLEAR without resorting to
- # hacks such as color_flags, above.
- }
+# $color &= ~NDI_CLEAR; # only clear once for multiline messages
+# # actually, this is an ugly design. _we_ should control the channels,
+# # not some random other widget, as the channels are clearly protocol-specific.
+# # then we could also react to flags such as CLEAR without resorting to
+# # hacks such as color_flags, above.
$self->{statusbox}->add ($text,
group => $text,
@@ -1210,7 +1245,7 @@
$conn->{open_container} = $tag;
update_floorbox;
- $::INVR_HB->clear ();
+ $::INVR_HB->clear;
$::INVR_HB->add (new DC::UI::Label expand => 1, text => $name);
if ($tag != 0) { # Floor isn't closable, is it?
@@ -1314,9 +1349,11 @@
my @yesno = ("no", "yes");
+ my $version = JSON::XS->new->encode ($self->{s_version});
+
$::SERVER_INFO->set_markup (
"server $self->{host}:$self->{port}\n"
- . "protocol version $self->{version}\n"
+ . "protocol version $version\n"
. "minimap support $yesno[$self->{setup}{mapinfocmd} > 0]\n"
. "extended command support $yesno[$self->{setup}{extcmd} > 0]\n"
. "examine command support $yesno[$self->{setup}{excmd} > 0]\n"
@@ -1354,7 +1391,7 @@
$self->update_server_info;
$self->send_command ("output-rate $::CFG->{output_rate}") if $::CFG->{output_rate} > 0;
- $self->send_command ("pickup $::CFG->{pickup}");
+ $self->send_pickup ($::CFG->{pickup});
}
sub lookat {
@@ -1528,7 +1565,12 @@
sub send {
my ($self, $msg) = @_;
- $self->{textview}->add_paragraph ({ markup => "\n" . DC::asxml $msg });
+ $self->{textview}->add_paragraph ({
+ markup =>
+ "\n"
+ . (DC::asxml $msg)
+ . ""
+ });
$self->{textview}->scroll_to_bottom;
$self->{conn}->send_ext_msg (npc_dialog_tell => $self->{id}, $msg);