view release on metacpan or  search on metacpan

DC/Protocol.pm  view on Meta::CPAN

   $::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_RES_PHYS});
   $::STATWIDS->{st_spd} ->set_text (sprintf "%.1f", $stats->{+CS_STAT_SPEED});
   $::STATWIDS->{st_wspd}->set_text (sprintf "%.1f", $stats->{+CS_STAT_WEAP_SP});
 
   $self->update_weight;

   $::STATWIDS->{"res_$_"}->set_text (sprintf "%d%%", $stats->{$RES_TBL{$_}})
      for keys %RES_TBL;

   my $sktbl = $::STATWIDS->{skill_tbl};
   my @skills = keys %{ $self->{skill_info} };

   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}{""} ||= [
         0, 0, (new DC::UI::Label text => "Experience", align => 1),
         1, 0, (new DC::UI::Label text => "Lvl.", align => 1),
         2, 0, (new DC::UI::Label text => "Progress"),
         3, 0, (new DC::UI::Label text => "Skill", expand => 1, align => 0),
         4, 0, (new DC::UI::Label text => "Experience", align => 1),
         5, 0, (new DC::UI::Label text => "Lvl.", align => 1),
         6, 0, (new DC::UI::Label text => "Progress"),
         7, 0, (new DC::UI::Label text => "Skill", expand => 1, align => 0),
      ];

      my @add = @$sw;

      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);

      my ($x, $y) = (0, 1);
      for (@order) {
         my ($idx, $name) = @$_;

         my $spell_cb = sub {
            my ($widget, $ev) = @_;

            if ($ev->{button} == 1) {
               $::CONN->user_send ("ready_skill $name");
            } elsif ($ev->{button} == 2) {
               $::CONN->user_send ("use_skill $name");
            } elsif ($ev->{button} == 3) {
               my $shortname = DC::shorten $name, 14;
               (new DC::UI::Menu
                  items => [
                     ["bind <i>ready_skill $shortname</i> to a key" => sub { DC::Macro::quick_macro ["ready_skill $name"] }],
                     ["bind <i>use_skill $shortname</i> to a key"   => sub { DC::Macro::quick_macro ["use_skill $name"]   }],
                  ],
               )->popup ($ev);
            } else {
               return 0;
            }

            1
         };

         my $sw = $self->{skillwid}{$idx} ||= [
            # exp
            (new DC::UI::Label
             align => 1, font => $::FONT_FIXED, fg => [1, 1, 0], on_button_down => $spell_cb, @TOOLTIP_EXP),

            # level
            (new DC::UI::Label
             text => "0", align => 1, font => $::FONT_FIXED, fg => [0, 1, 0], padding_x => 4, on_button_down => $spell_cb, @TOOLTIP_LVL),

            # progress
            (new DC::UI::ExperienceProgress),

            # label
            (new DC::UI::Label text => $name, on_button_down => $spell_cb, align => 0,
             can_events => 1, can_hover => 1, tooltip => (DC::Pod::section_label skill_description => $name) . $TOOLTIP_ALL),
         ];

         push @add,
            $x * 4 + 0, $y, $sw->[0],
            $x * 4 + 1, $y, $sw->[1],
            $x * 4 + 2, $y, $sw->[2],
            $x * 4 + 3, $y, $sw->[3],
         ;

         $x++ and ($x, $y) = (0, $y + 1);
      }

      $sktbl->add_at (@add);
   }

   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);

      $::GAUGES->{skillexp}->set_label ("$name %d%%");
      $::GAUGES->{skillexp}->set_value (@$val);
   }
}

sub user_send {
   my ($self, $command) = @_;