view release on metacpan or  search on metacpan

DC/UI.pm  view on Meta::CPAN

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;
   $self->{button} = $ev->{button};

   $self->show;

   my $x = $ev->{x};
   my $y = $ev->{y};

   $self->{root}->on_post_alloc ($self => sub {
      $self->move_abs ($x - $self->{w} * 0.25, $y - $self->{border} * $::FONTSIZE * .5);
   });

   1 # so it can be used inside event handlers
}

sub invoke_mouse_motion {
   my ($self, $ev, $x, $y) = @_;

   # TODO: should use vbox->find_widget or so
   $HOVER = $ROOT->find_widget ($ev->{x}, $ev->{y});
   $self->{hover} = $self->{item}{$HOVER};

   0
}

sub invoke_button_up {
   my ($self, $ev, $x, $y) = @_;

   if ($ev->{button} == $self->{button}) {
      undef $GRAB;
      $self->hide;

      $self->emit ("popdown");
      $self->{hover}[1]->() if $self->{hover};
   } else {
      return 0
   }

   1
}

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

package DC::UI::Multiplexer;

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

sub new {
   my $class = shift;

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

   $self->set_current_page (0);

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