view release on metacpan or  search on metacpan

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

   return @values if wantarray;
   return $values[0];
}

=head2 get_style_pen

   $pen = $widget->get_style_pen( $prefix )

A shortcut to calling C<get_style_values> to collect up the pen attributes,
and form a L<Tickit::Pen::Immutable> object from them. If C<$prefix> is
supplied, it will be prefixed on the pen attribute names with an underscore
(which would be read from the stylesheet file as a hyphen). Note that the
returned pen instance is immutable, and may be cached.

=cut

sub get_style_pen
{
   my $self = shift;
   my $class = ref $self;
   my ( $prefix ) = @_;

   return $self->{style_pen_cache}{$self->_style_tags}{$prefix//""} ||= do {
      my @keys = map { defined $prefix ? "${prefix}_$_" : $_ } @Tickit::Pen::ALL_ATTRS;

      my %attrs;
      @attrs{@Tickit::Pen::ALL_ATTRS} = $self->get_style_values( @keys );

      Tickit::Pen::Immutable->new( %attrs );
   };
}

=head2 get_style_text

   $text = $widget->get_style_text

A shortcut to calling C<get_style_values> for a single key called C<"text">.

=cut

sub get_style_text
{
   my $self = shift;
   my $class = ref $self;

   return $self->get_style_values( "text" ) // croak "$class style does not define text";
}

=head2 set_style

   $widget->set_style( %defs )

Changes the widget's direct-applied style.

C<%defs> should contain style keys optionally suffixed with tags in the same
form as that given to the C<style> key to the constructor. Defined values will
add to or replace values already stored by the widget. Keys mapping to
C<undef> are deleted from the stored style.

Note that changing the direct applied style is moderately costly because it
must invalidate all of the cached style values and pens that depend on the
changed keys. For normal runtime changes of style, consider using a tag if
possible, because style caching takes tags into account, and simply changing
applied style tags does not invalidate the caches.

=cut

sub set_style
{
   my $self = shift;
   my %defs = @_;

   my $new = Tickit::Style::_Tagset->new;
   $new->add( $_, $defs{$_} ) for keys %defs;

   my %values;
   foreach my $keyset ( $new->keysets ) {
      $values{$_} ||= [] for keys %{ $keyset->style };
   }

   my @keys = keys %values;

   my @old_values = $self->get_style_values( @keys );
   $values{$keys[$_]}[0] = $old_values[$_] for 0 .. $#keys;

   if( $self->{style_direct} ) {
      $self->{style_direct}->merge( $new );
   }
   else {
      $self->{style_direct} = $new;
   }

   $self->_style_changed_values( \%values, 1 );
}

sub _style_changed_values
{
   my $self = shift;
   my ( $values, $invalidate_caches ) = @_;

   my @keys = keys %$values;

   if( $invalidate_caches ) {
      foreach my $keyset ( values %{ $self->{style_cache} } ) {
         delete $keyset->{$_} for @keys;
      }
   }

   my @new_values = $self->get_style_values( @keys );

   # Remove unchanged keys
   foreach ( 0 .. $#keys ) {
      my $key = $keys[$_];
      my $old = $values->{$key}[0];
      my $new = $new_values[$_];

      delete $values->{$key}, next if !defined $old and !defined $new;
      delete $values->{$key}, next if defined $old and defined $new and $old eq $new;

      $values->{$key}[1] = $new;
   }

   my %changed_pens;
   foreach my $key ( @keys ) {
      PEN_ATTR_MAP->{$key} and
         $changed_pens{""}++;

      $key =~ m/^(.*)_([^_]+)$/ && PEN_ATTR_MAP->{$2} and
         $changed_pens{$1}++;
   }

   if( $invalidate_caches ) {
      foreach my $penset ( values %{ $self->{style_pen_cache} } ) {
         delete $penset->{$_} for keys %changed_pens;
      }
   }

   if( $changed_pens{""} ) {
      $self->_update_pen( $self->get_style_pen );
   }

   my $reshape = 0;
   my $redraw  = 0;

   my $type = $self->_widget_style_type;
   foreach ( Tickit::Style::_reshape_keys( $type ) ) {
      next unless $values->{$_};

      $reshape = 1;
      last;
   }

   foreach ( Tickit::Style::_reshape_textwidth_keys( $type ) ) {
      next unless $values->{$_};
      next if textwidth( $values->{$_}[0] ) == textwidth( $values->{$_}[1] );

      $reshape = 1;
      last;
   }

   foreach ( Tickit::Style::_redraw_keys( $type ) ) {
      next unless $values->{$_};

      $redraw = 1;
      last;
   }

   my $code = $self->can( "on_style_changed_values" );
   $self->$code( %$values ) if $code;

   if( $reshape ) {
      $self->reshape;
      $self->redraw;
   }
   elsif( keys %changed_pens or $redraw ) {
      $self->redraw;
   }
}

=head2 set_window

   $widget->set_window( $window )

Sets the L<Tickit::Window> for the widget to draw on. Setting C<undef> removes
the window.

If a window is associated to the widget, that window's pen is set to the
current widget pen. The widget is then drawn to the window by calling the
C<render_to_rb> method. If a window is removed (by setting C<undef>) then no
cleanup of the window is performed; the new owner of the window is expected to
do this.