view release on metacpan or  search on metacpan

DC/Protocol.pm  view on Meta::CPAN

package DC::Protocol;

use common::sense;

use Guard ();

use Deliantra::Protocol::Constants;

use DC;
use DC::DB;
use DC::UI;
use DC::Pod;
use DC::Macro;
use DC::Item;

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) = @_;

   my $self = $class->SUPER::new (%arg,
      setup_req => {
         extmap => 1,
         excmd  => 1,
         widget => 2,
         %{$arg{setup_req} || {}},
      },
   );

   $self->{map_widget}->clr_commands;

   my @cmd_help = map {
      $_->[DC::Pod::N_KW][0] =~ /^(\S+) (?:\s+ \( ([^\)]*) \) )?/x
         or die "unparseable command help: $_->[DC::Pod::N_KW][0]";

      my $cmd = $1;
      my @args = split /\|/, $2;
      @args = (".*") unless @args;

      my (undef, @par) = DC::Pod::section_of $_;
      my $text = DC::Pod::as_label @par;

      $_ = $_ eq ".*" ? "" : " $_"
         for @args;

      map ["$cmd$_", $text],
         sort { (length $a) <=> (length $b) }
            @args
   } sort { $a->[DC::Pod::N_PAR] <=> $b->[DC::Pod::N_PAR] }
          DC::Pod::find command => "*";

   $self->{json_coder}
      ->convert_blessed
      ->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
   $self->{on_stop_game_guard} = $self->{map_widget}{root}->connect (stop_game => sub {

DC/Protocol.pm  view on Meta::CPAN

   $::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) = @_;

   $self->{record}->($command)
      if $self->{record};