view release on metacpan or  search on metacpan

DC/Protocol.pm  view on Meta::CPAN

# widgetset create template
sub ext_ws_ct {
   my ($self, $ws, $type, $template, $done_cb, $cfg) = @_;

   $done_cb ||= sub { };

   my $parse_list; $parse_list = sub {
      my ($list) = @_;
      my @w;

      while (@$list) {
         my ($class, $args) = splice @$list, 0, 2;
         my $name = delete $args->{s_id};
         my $cl   = delete $args->{s_cl};
         my $cfg  = delete $cfg->{$name};
         my $id   = delete $cfg->{id};
         my $w    = eval { "DC::UI::$class"->new (%$args, %{ $cfg || {} }) }
                       or next;

         $self->widget_associate ($ws, $id, $w)
            if $id;

         $w->add ($parse_list->($cl))
            if $cl;

         push @w, $w;
      }

      @w
   };

   # either array reference, or face #
   if ($type eq "inline") {
      $done_cb->();
      $parse_list->($template);
   } elsif ($type eq "face") {
      my $handler; $handler = $self->register_face_handler ($template, sub {
         my ($face) = @_;

         undef $handler;
         $done_cb->();
         $parse_list->($self->{json_coder}->decode ($face->{data}));
      });
   } else {
      $done_cb->(0);
   }
}

# widgetset associate
sub ext_ws_a {
   my ($self, %ass) = @_;

   # everything that has a name, wether conceivably useful or not
   my %wkw = (
      root           => $DC::UI::ROOT,
      tooltip        => $DC::UI::TOOLTIP,

      mapwidget      => $::MAPWIDGET,
      menubar        => $::MENUBAR,
      menupopup      => $::MENUPOPUP,
      pickup_enable  => $::PICKUP_ENABLE,
      buttonbar      => $::BUTTONBAR,
      metaserver     => $::METASERVER,
      buttonbar      => $::BUTTONBAR,
      login_button   => $::LOGIN_BUTTON,
      quit_dialog    => $::QUIT_DIALOG,
      host_entry     => $::HOST_ENTRY,
      metaserver     => $::METASERVER,
      server_info    => $::SERVER_INFO,

      setup_dialog   => $::SETUP_DIALOG,
      setup_notebook => $::SETUP_NOTEBOOK,
      setup_server   => $::SETUP_SERVER,
      setup_keyboard => $::SETUP_KEYBOARD,

      pl_notebook    => $::PL_NOTEBOOK,
      pl_window      => $::PL_WINDOW,
      inventory_page => $::INVENTORY_PAGE,
      stats_page     => $::STATS_PAGE,
      skill_page     => $::SKILL_PAGE,
      spell_page     => $::SPELL_PAGE,
      spell_list     => $::SPELL_LIST,

      floorbox       => $::FLOORBOX,
      help_window    => $::HELP_WINDOW,
      message_window => $::MESSAGE_WINDOW,
      message_dist   => $::MESSAGE_DIST,
      statusbox      => $::STATUSBOX,

      inv            => $::INV,
      invr           => $::INVR,
      invr_hb        => $::INVR_HB,
   );

   while (my ($id, $name) = each %ass) {
      $self->widget_associate (undef, $id => $wkw{$name});
   }
}

# widget call
sub ext_w_c {
   my ($self, $id, $rcb, $method, @args) = @_;

   my $w = $self->{widget}{$id}
      or return;

   if ($rcb) {
      $rcb->($w->$method (@args));
   } else {
      $w->$method (@args);
   }
}

# widget set
sub ext_w_s {
   my ($self, $id, $attr) = @_;

   my $w = $self->{widget}{$id}
      or return;

DC/Protocol.pm  view on Meta::CPAN

   $::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};

   $self->logprint ("send: ", $command);