--- deliantra/Deliantra-Client/DC/Protocol.pm	2008/09/03 06:35:55	1.201
+++ deliantra/Deliantra-Client/DC/Protocol.pm	2012/11/04 14:28:24	1.223
@@ -1,7 +1,8 @@
 package DC::Protocol;
 
-use utf8;
-use strict;
+use common::sense;
+
+use Guard ();
 
 use Deliantra::Protocol::Constants;
 
@@ -15,10 +16,12 @@
 use base 'Deliantra::Protocol::Base';
 
 our $TEX_DIALOGUE = new_from_resource DC::Texture
-         "dialogue.png", minify => 1, mipmap => 1;
+        "dialogue.png", minify => 1, mipmap => 1;
 
 our $TEX_NOFACE = new_from_resource DC::Texture
-        "noface.png", minify => 1, mipmap => 1;
+        "noface.png", minify => 1, mipmap => 1, wrap => 1;
+
+sub MIN_TEXTURE_UNUSED() { 1 }#d#
 
 sub new {
    my ($class, %arg) = @_;
@@ -26,12 +29,46 @@
    my $self = $class->SUPER::new (%arg,
       setup_req => {
          extmap => 1,
-         excmd  => 1,
          widget => 2,
          %{$arg{setup_req} || {}},
       },
    );
 
+   $self->update_fx_want;
+
+   my $exp_guard = $self->addme_guard;
+   my $skl_guard = $self->addme_guard;
+   my $spl_guard = $self->addme_guard;
+   $self->send_exti_req (resource => qw(exp_table skill_info spell_paths), sub {
+      my ($exp, $skl, $spl) = @_;
+
+      $self->register_face_handler ($exp, sub {
+         my ($face) = @_;
+
+         undef $exp_guard;
+         $self->{exp_table} = $self->{json_coder}->decode (delete $face->{data});
+         $_->() for values %{ $self->{on_exp_update} };
+      });
+
+      $self->register_face_handler ($skl, sub {
+         my ($face) = @_;
+
+         undef $skl_guard;
+         my $info = $self->{json_coder}->decode (delete $face->{data});
+         $self->{skill_info} = { map { CS_STAT_SKILLINFO + $_ => $info->[$_][0] } 0 .. $#$info };
+      });
+
+      $self->register_face_handler ($spl, sub {
+         my ($face) = @_;
+
+         undef $spl_guard;
+         my $info = $self->{json_coder}->decode (delete $face->{data});
+         $self->{spell_paths} = { map { (1 << $_) => $info->[$_][0] } 0 .. $#$info };
+      });
+
+      ()
+   });
+
    $self->{map_widget}->clr_commands;
 
    my @cmd_help = map {
@@ -75,6 +112,7 @@
 
       delete $self->{items};
       $::INV->clear;
+      $::INVR->clear;
       $::INVR_HB->clear;
       $::FLOORBOX->clear;
    });
@@ -92,6 +130,21 @@
       $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} = AE::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
@@ -113,21 +166,6 @@
 sub ext_capabilities {
    my ($self, %cap) = @_;
 
-   $self->update_fx_want;
-
-   $self->send_exti_req (resource => "exp_table", sub {
-      my ($exp_table) = @_;
-
-      $self->register_face_handler ($exp_table, sub {
-         my ($face) = @_;
-
-         $self->{exp_table} = $self->{json_coder}->decode (delete $face->{data});
-         $_->() for values %{ $self->{on_exp_update} || {} };
-      });
-
-      ()
-   });
-
    if (my $ts = $cap{tileset}) {
       if (my ($default) = grep $_->[2] & 1, @$ts) {
          $self->{tileset} = $default;
@@ -261,6 +299,9 @@
       tooltip        => $DC::UI::TOOLTIP,
 
       mapwidget      => $::MAPWIDGET,
+      menubar        => $::MENUBAR,
+      menupopup      => $::MENUPOPUP,
+      pickup_enable  => $::PICKUP_ENABLE,
       buttonbar      => $::BUTTONBAR,
       metaserver     => $::METASERVER,
       buttonbar      => $::BUTTONBAR,
@@ -287,7 +328,7 @@
       help_window    => $::HELP_WINDOW,
       message_window => $::MESSAGE_WINDOW,
       message_dist   => $::MESSAGE_DIST,
-      statusbox      => $::SDTATUSBOX,
+      statusbox      => $::STATUSBOX,
 
       inv            => $::INV,
       invr           => $::INVR,
@@ -381,7 +422,7 @@
                  }
               sort { $a <=> $b } keys %{$self->{spell_paths}};
 
-   join "", @diff
+   "\u$name: " . (join ", ", @diff)
 }
 
 # all stats that are chacked against changes
@@ -434,7 +475,7 @@
           (
              ($stats->{+CS_STAT_EXP64} > $prev->{+CS_STAT_EXP64} ? ($stats->{+CS_STAT_EXP64} - $prev->{+CS_STAT_EXP64}) . " experience gained" : ()),
              map {
-                $stats->{$_} && $prev->{$_} 
+                $stats->{$_} && $prev->{$_}
                    && $stats->{$_}[1] > $prev->{$_}[1] ? "($self->{skill_info}{$_}+" . ($stats->{$_}[1] - $prev->{$_}[1]) . ")" : ()
              } sort { $a <=> $b } keys %{$self->{skill_info}}
           )
@@ -446,7 +487,7 @@
    if (
       my @diffs = map $_->[1]->($self, $_->[2], $prev->{$_->[0]}, $stats->{$_->[0]}), @statchange
    ) {
-      my $msg = "<b>stat change</b>: " . (join " ", @diffs);
+      my $msg = "<b>stat change</b>: " . (join " ", map "($_)", @diffs);
       $self->{statusbox}->add ($msg, group => "stat $msg", fg => [0.8, 1, 0.2, 1], timeout => 20);
    }
 
@@ -494,9 +535,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: //;
@@ -518,7 +559,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};
@@ -547,7 +588,7 @@
 
       my @add = @$sw;
 
-      my $TOOLTIP_ALL = "\n\n<small>Left click - ready skill\nMiddle click - use spell\nRight click - further options</small>";
+      my $TOOLTIP_ALL = "\n\n<small>Left click - ready skill\nMiddle click - use skill\nRight click - further options</small>";
 
       my @TOOLTIP_LVL  = (tooltip => "<b>Level</b>. The level of the skill.$TOOLTIP_ALL", can_events => 1, can_hover => 1);
       my @TOOLTIP_EXP  = (tooltip => "<b>Experience</b>. The experience points you have in this skill.$TOOLTIP_ALL", can_events => 1, can_hover => 1);
@@ -619,8 +660,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);
    }
 }
 
@@ -649,7 +690,7 @@
 sub feed_map1a {
    my ($self, $data) = @_;
 
-   my $missing = $self->{map}->map1a_update ($data, $self->{setup}{extmap});
+   my $missing = $self->{map}->map1a_update ($data);
    my $delay;
 
    for my $tile (@$missing) {
@@ -657,12 +698,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;
@@ -671,7 +712,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};
@@ -969,7 +1010,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;
@@ -984,7 +1025,7 @@
    push @{$self->{face_cb}{$num}}, $cb;
 
    defined wantarray
-      ? DC::guard {
+      ? Guard::guard {
            @{$self->{face_cb}{$num}}
               = grep $_ != $cb,
                    @{$self->{face_cb}{$num}};
@@ -1022,7 +1063,7 @@
    $prompt = $LAST_QUERY unless length $prompt;
    $LAST_QUERY = $prompt;
 
-   $self->{query}-> ($self, $flags, $prompt);
+   $self->{query}->($self, $flags, $prompt);
 }
 
 sub sanitise_xml($) {
@@ -1094,25 +1135,19 @@
 
       my $fg = $CF_COLOR[$color & NDI_COLOR_MASK] || [1, 0, 0];
 
-      ## try to create single paragraphs of multiple lines sent by the server
-      # 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,
@@ -1329,15 +1364,12 @@
 
    my @yesno = ("<span foreground='red'>no</span>", "<span foreground='green'>yes</span>");
 
+   my $version = JSON::XS->new->encode ($self->{s_version});
+
    $::SERVER_INFO->set_markup (
       "server <tt>$self->{host}:$self->{port}</tt>\n"
-    . "protocol version <tt>$self->{version}</tt>\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"
+    . "protocol version <tt>$version</tt>\n"
     . "editing support $yesno[!!$self->{editor_support}]\n"
-    . "map attributes $yesno[$self->{setup}{extmap} > 0]\n"
-    . "big image protocol support $yesno[$self->{setup}{fxix} > 0]\n"
     . "client support $yesno[$self->{cfplus_ext} > 0]"
       . ($self->{cfplus_ext} > 0 ? ", version $self->{cfplus_ext}" : "") ."\n"
     . "map size $self->{mapw}×$self->{maph}\n"
@@ -1369,10 +1401,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_exti_msg (clientlog => sprintf "OpenGL Info: %s [%s]",
-                                              DC::OpenGL::gl_vendor, DC::OpenGL::gl_version);#d#
+   $self->send_pickup ($::CFG->{pickup});
 }
 
 sub lookat {
@@ -1384,7 +1413,7 @@
 
          if (exists $msg{npc_dialog}) {
             # start npc chat dialog
-            $self->{npc_dialog} = new DC::NPCDialog::
+            $self->{w}{npc_dialog} = new DC::NPCDialog::
                token => $msg{npc_dialog},
                title => "$msg{npc_dialog}[0] (NPC)",
                conn  => $self,
@@ -1399,8 +1428,8 @@
 sub destroy {
    my ($self) = @_;
 
-   (delete $self->{npc_dialog})->destroy
-      if $self->{npc_dialog};
+   $_->destroy
+      for values %{ $self->{w} };
 
    $self->SUPER::destroy;
 
@@ -1546,7 +1575,12 @@
 sub send {
    my ($self, $msg) = @_;
 
-   $self->{textview}->add_paragraph ({ markup => "\n" . DC::asxml $msg });
+   $self->{textview}->add_paragraph ({
+      markup =>
+         "\n<span foreground='#ffff00'><b>"
+         . (DC::asxml $msg)
+         . "</b></span>"
+   });
    $self->{textview}->scroll_to_bottom;
 
    $self->{conn}->send_ext_msg (npc_dialog_tell => $self->{id}, $msg);
@@ -1559,7 +1593,7 @@
 
    if ($self->{conn}) {
       $self->{conn}->send_ext_msg (npc_dialog_end => $self->{id}) if $self->{id};
-      delete $self->{conn}{npc_dialog};
+      delete $self->{conn}{w}{npc_dialog};
       $self->{conn}->disconnect_ext ($self->{id});
    }