view release on metacpan or  search on metacpan

DC/UI.pm  view on Meta::CPAN

   $self->{face} = $face;
   $self->reconfigure;
}

sub set_anim {
   my ($self, $anim) = @_;

   $self->{anim} = $anim;
   $self->update_anim;
}

sub set_animspeed {
   my ($self, $animspeed) = @_;

   $self->{animspeed} = $animspeed;
   $self->update_anim;
}

sub invoke_visibility_change {
   my ($self) = @_;

   $self->update_timer;

   0
}

sub _draw {
   my ($self) = @_;

   $self->SUPER::_draw;

   if (my $tex = $self->{tex}) {
      glEnable GL_TEXTURE_2D;
      glTexEnv GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE;
      glColor 0, 0, 0, 1;
      $tex->draw_quad_alpha (0, 0, $self->{w}, $self->{h});
      glDisable GL_TEXTURE_2D;
   }
}

sub destroy {
   my ($self) = @_;

   (delete $self->{timer})->cancel
      if $self->{timer};

   $self->SUPER::destroy;
}

#############################################################################

package DC::UI::Buttonbar;

our @ISA = DC::UI::HBox::;

# TODO: should actually wrap buttons and other goodies.

#############################################################################

package DC::UI::Menu;

our @ISA = DC::UI::Toplevel::;

use DC::OpenGL;

sub new {
   my $class = shift;

   my $self = $class->SUPER::new (
      items => [],
      z     => 100,
      @_,
   );

   $self->add ($self->{vbox} = new DC::UI::VBox);

   for my $item (@{ $self->{items} }) {
      my ($widget, $cb, $tooltip) = @$item;

      # handle various types of items, only text for now
      if (!ref $widget) {
         if ($widget =~ /\t/) {
            my ($left, $right) = split /\t/, $widget, 2;

            $widget = new DC::UI::HBox
               can_hover  => 1,
               can_events => 1,
               tooltip    => $tooltip,
               children   => [
                  (new DC::UI::Label markup => $left , align => 0, expand => 1),
                  (new DC::UI::Label markup => $right, align => 1),
               ],
            ;

         } else {
            $widget = new DC::UI::Label
               can_hover  => 1,
               can_events => 1,
               align      => 0,
               markup     => $widget,
               tooltip    => $tooltip;
         }
      }

      $self->{item}{$widget} = $item;

      $self->{vbox}->add ($widget);
   }

   $self
}

# popup given the event (must be a mouse button down event currently)
sub popup {
   my ($self, $ev) = @_;

   $self->emit ("popdown");

   # maybe save $GRAB? must be careful about events...
   $GRAB = $self;

DC/UI.pm  view on Meta::CPAN

sub set_current_page {
   my ($self, $page) = @_;

   $self->{multiplexer}->set_current_page ($page);
   $self->emit (page_changed => $self->{multiplexer}{current});
}

sub _draw {
   my ($self) = @_;

   $self->SUPER::_draw ();

   if (my $cur = $self->{multiplexer}{current}) {
      if ($cur = $cur->{c_tab_}) {
         glTranslate $self->{buttonbar}{x} + $cur->{x},
                     $self->{buttonbar}{y} + $cur->{y};
         glLineWidth 3;
         #glEnable GL_BLEND;
         #glBlendFunc GL_ONE, GL_ONE_MINUS_SRC_ALPHA;
         glColor @{$self->{active_outline}};
         glRect_lineloop 1.5, 1.5, $cur->{w} - 1.5, $cur->{h} - 1.5;
         glLineWidth 1;
         #glDisable GL_BLEND;
      }
   }
}

#############################################################################

package DC::UI::Selector;

use utf8;

our @ISA = DC::UI::Button::;

sub new {
   my $class = shift;

   my $self = $class->SUPER::new (
      options => [], # [value, title, longdesc], ...
      value   => undef,
      @_,
   );

   $self->_set_value ($self->{value});

   $self
}

sub invoke_button_down {
   my ($self, $ev) = @_;

   my @menu_items;

   for (@{ $self->{options} }) {
      my ($value, $title, $tooltip) = @$_;

      push @menu_items, [$tooltip || $title, sub { $self->set_value ($value) }];
   }

   DC::UI::Menu->new (items => \@menu_items)->popup ($ev);
}

sub _set_value {
   my ($self, $value) = @_;

   my ($item) = grep $_->[0] eq $value, @{ $self->{options} };
   $item ||= $self->{options}[0]
      or return;

   $self->{value} = $item->[0];
   $self->set_markup ("$item->[1] ⇓");
#   $self->set_tooltip ($item->[2]);
}

sub set_value {
   my ($self, $value) = @_;

   return unless $self->{value} ne $value;

   $self->_set_value ($value);
   $self->emit (changed => $value);
}

sub set_options {
   my ($self, $options) = @_;

   $self->{options} = $options;
   $self->_set_value ($self->{value});
}

#############################################################################

package DC::UI::Statusbox;

our @ISA = DC::UI::VBox::;

sub new {
   my $class = shift;

   my $self = $class->SUPER::new (
      fontsize => 0.8,
      @_,
   );

   DC::weaken (my $this = $self);

   $self->{timer} = EV::timer 1, 1, sub { $this->reorder };

   $self
}

sub reorder {
   my ($self) = @_;
   my $NOW = EV::time;

   # freeze display when hovering over any label
   return if $DC::UI::TOOLTIP->{owner}
             && grep $DC::UI::TOOLTIP->{owner} == $_->{label},
                   values %{ $self->{item} };