view release on metacpan or  search on metacpan

lib/Tickit/Widget/Button.pm  view on Meta::CPAN

=cut

method click
{
   $_on_click->( $self );
}

# Activation by key should "flash" the button briefly on the screen as a
# visual feedback
method key_click
{
   $self->click;
   if( my $window = $self->window ) {
      $self->set_style_tag( active => 1 );
      $window->tickit->timer( after => 0.1, sub { $self->set_style_tag( active => 0 ) } );
   }
   return 1;
}

method _activate
{
   my ( $active ) = @_;
   $self->{active} = $active;
   $self->set_style_tag( active => $active );
}

=head2 $align = $button->align

=head2 $button->set_align( $align )

=head2 $valign = $button->valign

=head2 $button->set_valign( $valign )

Accessors for the horizontal and vertical alignment of the label text within
the button area. See also L<Tickit::WidgetRole::Alignable>.

=cut

use Tickit::WidgetRole::Alignable name => "align",  style => "h";
use Tickit::WidgetRole::Alignable name => "valign", style => "v";

method reshape
{
   my $win = $self->window or return;
   my $lines = $win->lines;
   my $cols  = $win->cols;

   my $width = textwidth $self->label;

   my $has_border = ( $self->get_style_values( "linetype" ) ) ne "none";

   my ( $lines_before, undef, $lines_after ) = $self->_valign_allocation( 1, $lines - (2 * $has_border) );
   my ( $cols_before, undef, $cols_after ) = $self->_align_allocation( $width + 2, $cols - 2 );

   $self->{label_line} = $lines_before + $has_border;
   $self->{label_col}  = $cols_before + 2;
   $self->{label_end}  = $cols_before + $width + 2;

   $win->cursor_at( $self->{label_line}, $self->{label_col} );
}

method render_to_rb
{
   my ( $rb, $rect ) = @_;

   my $win = $self->window or return;
   my $lines = $win->lines;
   my $cols  = $win->cols;

   my ( $linetype, $marker_left, $marker_right ) =
      $self->get_style_values(qw( linetype marker_left marker_right ));

   my $linestyle = $linetype eq "single" ? LINE_SINGLE :
                   $linetype eq "double" ? LINE_DOUBLE :
                   $linetype eq "thick"  ? LINE_THICK  :
                   undef;

   if( defined $linestyle ) {
      $rb->hline_at( 0,        0, $cols-1, $linestyle );
      $rb->hline_at( $lines-1, 0, $cols-1, $linestyle );
      $rb->vline_at( 0, $lines-1, 0,       $linestyle );
      $rb->vline_at( 0, $lines-1, $cols-1, $linestyle );

      foreach my $line ( $rect->linerange( 1, $lines-2 ) ) {
         $rb->erase_at( $line, 1, $cols-2 );
      }
   }
   else {
      foreach my $line ( $rect->linerange( 0, $lines-1 ) ) {
         $rb->erase_at( $line, 0, $cols );
      }
   }

   $rb->text_at( $self->{label_line}, $self->{label_col} - 2, $marker_left );
   $rb->text_at( $self->{label_line}, $self->{label_end}, $marker_right );

   $rb->text_at( $self->{label_line}, $self->{label_col}, $self->label );
}

method on_mouse
{
   my ( $args ) = @_;

   my $type = $args->type;
   my $button = $args->button;

   return if $type eq "wheel" or $button != 1;

   if( $type eq "press" ) {
      $self->_activate( 1 );
   }
   elsif( $type eq "drag_start" ) {
      $self->{dragging_on_self} = 1;
   }
   elsif( $type eq "drag_stop" ) {
      $self->{dragging_on_self} = 0;
   }
   elsif( $type eq "drag" ) {
      # TODO: This could be neater with an $arg->srcwin