--- deliantra/Deliantra-Client/DC/Protocol.pm	2007/08/21 17:54:02	1.159
+++ deliantra/Deliantra-Client/DC/Protocol.pm	2007/09/02 05:18:34	1.173
@@ -12,8 +12,6 @@
 use CFPlus::Macro;
 use CFPlus::Item;
 
-use Crossfire::Protocol::Base 0.95;
-
 use base 'Crossfire::Protocol::Base';
 
 sub new {
@@ -23,7 +21,7 @@
       setup_req => {
          extmap => 1,
          excmd  => 1,
-         xwidget1 => 1,#d#
+         xwidget2 => 1,#d#
          %{$arg{setup_req} || {}},
       },
    );
@@ -52,8 +50,14 @@
 
    $self->{json_coder}
       ->convert_blessed
-      ->filter_json_single_key_object (__w_ => sub {
+      ->filter_json_single_key_object ("\fw" => sub {
          $self->{widget}{$_[0]}
+      })
+      ->filter_json_single_key_object ("\fc" => sub {
+         my ($id) = @_;
+         sub {
+            $self->send_exti_msg (w_e => $id, @_);
+         }
       });
 
    # destroy widgets on logout
@@ -140,34 +144,28 @@
 sub widget_associate {
    my ($self, $ws, $id, $widget) = @_;
 
-   if ($widget) {
-      $widget->{s_id} = $id;
-      $self->{widget}{$id} = $widget;
-
-      if ($ws) {
-         $widget->{s_ws} = $ws;
-         $self->{widgetset}{$ws}{w}{$id} = $widget;
-      }
+   $widget ||= new CFPlus::UI::Bin;
 
-      $widget->connect (on_destroy => sub {
-         my ($widget) = @_;
+   $widget->{s_id} = $id;
+   $self->{widget}{$id} = $widget;
 
-         delete $self->{widget}{$widget->{s_id}};
-         delete $self->{widgetset}{$widget->{s_ws}}{$widget->{s_id}}
-            if exists $widget->{s_ws};
-      });
+   if ($ws) {
+      $widget->{s_ws} = $ws;
+      $self->{widgetset}{$ws}{w}{$id} = $widget;
+   }
 
-      1
-   } else {
-      $self->send_exti_msg (w_e => $id, undef);
+   $widget->connect (on_destroy => sub {
+      my ($widget) = @_;
 
-      0
-   }
+      delete $self->{widget}{$widget->{s_id}};
+      delete $self->{widgetset}{$widget->{s_ws}}{$widget->{s_id}}
+         if exists $widget->{s_ws};
+   });
 }
 
 # widgetset new
 sub ext_ws_n {
-   my ($id) = @_;
+   my ($self, $id) = @_;
 
    $self->{widgetset}{$id} = {
       w => {},
@@ -176,7 +174,7 @@
 
 # widgetset destroy
 sub ext_ws_d {
-   my ($id) = @_;
+   my ($self, $id) = @_;
 
    my $ws = delete $self->{widgetset}{$id}
       or return;
@@ -186,30 +184,20 @@
 }
 
 # widgetset create
-sub ext_ws_c => sub {
-   my ($ws, $id, $class, $args) = @_;
-
-   for my $ev (grep /^on_/, keys %$args) {
-      my $rid = $args->{$ev};
-      $args->{$ev} = sub {
-         my $id = shift->{s_id};
-         $self->send_exti_msg (w_e => $id, $rid, @_);
-
-         1
-      };
-   }
+sub ext_ws_c {
+   my ($self, $ws, $id, $class, $args) = @_;
 
    $self->widget_associate (
       $ws, $id => scalar eval {
          local $SIG{__DIE__};
          "CFPlus::UI::$class"->new (%$args)
       }
-   ) or warn "server failed creating client-side widget " . (CFPlus::to_json $class) . ": $@\n";
+   );
 }
 
 # widgetset associate
 sub ext_ws_a {
-   my (%ass) = @_;
+   my ($self, %ass) = @_;
 
    # everything that has a name, wether conceivably useful or not
    my %wkw = (
@@ -250,20 +238,19 @@
    );
 
    while (my ($id, $name) = each %ass) {
-      $self->widget_associate (undef, $id => $wkw{$name})
-         or warn "server failed to associate non-existent well-known widget $name\n";
+      $self->widget_associate (undef, $id => $wkw{$name});
    }
 }
 
 # widget call
 sub ext_w_c {
-   my ($id, $rid, $method, @args) = @_;
+   my ($self, $id, $rcb, $method, @args) = @_;
 
    my $w = $self->{widget}{$id}
       or return;
 
-   if ($rid) {
-      $self->send_exti_msg (w_r => $rid, $w->$method (@args));
+   if ($rcb) {
+      $rcb->($w->$method (@args));
    } else {
       $w->$method (@args);
    }
@@ -271,7 +258,7 @@
 
 # widget set
 sub ext_w_s {
-   my ($id, $attr) = @_;
+   my ($self, $id, $attr) = @_;
 
    my $w = $self->{widget}{$id}
       or return;
@@ -289,17 +276,17 @@
 
 # widget get
 sub ext_w_g {
-   my ($id, $rid, $attr) = @_;
+   my ($self, $id, $rid, @attr) = @_;
 
    my $w = $self->{widget}{$id}
       or return;
 
-   $self->send_exti_msg (w_r => $rid, [map $w->{$_}, @$attr]);
-})
+   $self->send_exti_msg (w_e => $rid, map $w->{$_}, @attr);
+}
 
 # message window
 sub ext_channel_info {
-   my ($info) = @_;
+   my ($self, $info) = @_;
    $self->{channels}->{$info->{id}} = $info;
    $::MESSAGE_WINDOW->add_channel ($info);
 }
@@ -403,7 +390,7 @@
       my @diffs = map $_->[1]->($self, $_->[2], $prev->{$_->[0]}, $stats->{$_->[0]}), @statchange
    ) {
       my $msg = "<b>stat change</b>: " . (join " ", @diffs);
-      $self->{statusbox}->add ($msg, group => "stat $msg", fg => [0.8, 1, 0.2, 1], timeout => 10);
+      $self->{statusbox}->add ($msg, group => "stat $msg", fg => [0.8, 1, 0.2, 1], timeout => 20);
    }
 
    $self->update_stats_window ($stats, $prev);
@@ -480,7 +467,14 @@
    my $sktbl = $::STATWIDS->{skill_tbl};
    my @skills = keys %{ $self->{skill_info} };
 
-   if (grep +(exists $stats->{$_}) != (exists $prev->{$_}), @skills) {
+   my @order = sort { $stats->{$b->[0]}[1] <=> $stats->{$a->[0]}[1] or $a->[1] cmp $b->[1] }
+               map [$_, $self->{skill_info}{$_}],
+               grep exists $stats->{$_},
+               @skills;
+  
+   if ($self->{stat_order} ne join ",", map $_->[0], @order) {
+      $self->{stat_order} = join ",", map $_->[0], @order;
+
       $sktbl->clear;
 
       my $sw = $self->{skillwid}{""} ||= [
@@ -502,12 +496,7 @@
       my @TOOLTIP_EXP  = (tooltip => "<b>Experience</b>. The experience points you have in this skill.$TOOLTIP_ALL", can_events => 1, can_hover => 1);
 
       my ($x, $y) = (0, 1);
-      for (
-         sort { $stats->{$b->[0]}[1] <=> $stats->{$a->[0]}[1] or $a->[1] cmp $b->[1] }
-         map [$_, $self->{skill_info}{$_}],
-         grep exists $stats->{$_},
-           @skills
-      ) {
+      for (@order) {
          my ($idx, $name) = @$_;
 
          my $spell_cb = sub {
@@ -562,19 +551,19 @@
       $sktbl->add_at (@add);
    }
 
-   for (grep exists $stats->{$_}, @skills) {
-      my $sw = $self->{skillwid}{$_};
-      $sw->[0]->set_text (::formsep ($stats->{$_}[1]));
-      $sw->[1]->set_text ($stats->{$_}[0] * 1);
-      $sw->[2]->set_value (@{$stats->{$_}});
-   }
-}
-
-sub macro_send {
-   my ($self, $macro) = @_;
+   for (@order) {
+      my ($idx, $name) = @$_;
+      my $val = $stats->{$idx};
+
+      next if $prev->{$idx}[1] eq $val->[1];
+
+      my $sw = $self->{skillwid}{$idx};
+      $sw->[0]->set_text (::formsep ($val->[1]));
+      $sw->[1]->set_text ($val->[0] * 1);
+      $sw->[2]->set_value (@$val);
 
-   for my $cmd (@{ $macro->{action} }) {
-      $self->send_command ($cmd);
+      $::GAUGES->{sklprg}->set_label ("$name %d%%");
+      $::GAUGES->{sklprg}->set_value (@$val);
    }
 }
 
@@ -586,7 +575,6 @@
 
    $self->logprint ("send: ", $command);
    $self->send_command ($command);
-   ::status ($command);
 }
 
 sub record {
@@ -629,7 +617,8 @@
       # delay the map drawing a tiny bit in the hope of getting the missing fetched
       Event->timer (after => 0.03, cb => sub {
          $_[0]->w->cancel;
-         $self->{map_widget}->update;
+         $self->{map_widget}->update
+            if $self->{map_widget};
       });
    } else {
       $self->{map_widget}->update;
@@ -878,23 +867,19 @@
          my ($meta, $data) = unpack "(w/a*)*", $face->{data};
          $face->{data} = $meta;
 
+         # rely on strict ordering here and also on later fetch
          CFPlus::DB::put res_data => $face->{name} => $data, sub { };
          CFPlus::DB::put res_meta => $face->{name} => $meta, sub { };
       }
 
       $face->{data} = $self->{json_coder}->decode ($face->{data});
-
       ::add_license ($face);
+      ::message ({ markup => CFPlus::asxml "downloaded resource '$face->{data}{name}', type $face->{type}." })
+         if $changed;
 
       if ($face->{type} == 3) { # FT_MUSIC
-         ::message ({ markup => "downloaded song #$facenum" })
-            if $changed;
-
          &::audio_music_push ($facenum);
       } elsif ($face->{type} == 5) { # FT_SOUND
-         ::message ({ markup => "downloaded sound #$facenum" })
-            if $changed;
-
          &::audio_sound_push ($facenum);
       }
 
@@ -984,7 +969,11 @@
    local $_ = shift;
 
    # we now weed out all tags we do not support
-   s%<(?!/?i>|/?u>|/?b>|fg |/fg>)%&lt;%g;
+   s{ <(?! /?i> | /?u> | /?b> | /?big | /?small | /?s | /?tt | fg\ | /fg>)
+   }{
+      "&lt;"
+   }gex;
+
    # now all entities
    s/&(?!amp;|lt;|gt;|apos;|quot;|#[0-9]+;|#x[0-9a-fA-F]+;)/&amp;/g;
 
@@ -1047,20 +1036,28 @@
       # no longer neecssary with TRT servers
       #$text =~ s/(?<=\S)\n(?=\w)/ /g;
 
-      ::message ({
-         fg          => $fg,
-         markup      => $_,
-         type        => $type,
-         extra       => [@extra],
-         color_flags => $color
-      }) for split /\n/, $text;
+      for (split /\n/, $text) {
+         ::message ({
+            fg     => $fg,
+            markup => $_,
+            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.
+      }
 
       $self->{statusbox}->add ($text,
          group        => $text,
          fg           => $fg,
          timeout      => $color >= 2 ? 180 : 10,
          tooltip_font => $::FONT_FIXED,
-      );
+      ) if $type eq "info";
    }
 }