--- deliantra/Deliantra-Client/DC/Protocol.pm 2008/05/08 20:19:49 1.195 +++ 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}}; @@ -1085,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, @@ -1212,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? @@ -1316,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" @@ -1356,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 { @@ -1530,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);