view release on metacpan or  search on metacpan

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

=cut

sub new
{
   my $class = shift;
   my %args = @_;

   foreach my $method (qw( lines cols render_to_rb )) {
      $class->can( $method ) or
         croak "$class cannot ->$method - do you subclass and implement it?";
   }

   my $self = bless {
      classes => delete $args{classes} // [ delete $args{class} ],
   }, $class;

   # Legacy direct-applied-style argument support
   $args{$_} and $args{style}{$_} = delete $args{$_} for @Tickit::Pen::ALL_ATTRS;

   if( my $style = delete $args{style} ) {
      my $tagset = $self->{style_direct} = Tickit::Style::_Tagset->new;
      foreach my $key ( keys %$style ) {
         $tagset->add( $key, $style->{$key} );
      }
   }

   $self->_update_pen( $self->get_style_pen );

   return $self;
}

=head1 METHODS

=cut

=head2 style_classes

   @classes = $widget->style_classes

Returns a list of the style class names this Widget has.

=cut

sub style_classes
{
   my $self = shift;
   return @{ $self->{classes} };
}

=head2 set_style_tag

   $widget->set_style_tag( $tag, $value )

Sets the (boolean) state of the named style tag. After calling this method,
the C<get_style_*> methods may return different results. No resizing or
redrawing is necessarily performed; but the widget can use
C<style_reshape_keys>, C<style_reshape_textwidth_keys> or C<style_redraw_keys>
to declare which style keys should cause automatic reshaping or redrawing. In
addition it can override the C<on_style_changed_values> method to inspect the
changes and decide for itself.

=cut

# This is cached, so will need invalidating on style loads
my %KEYS_BY_TYPE_CLASS_TAG;
Tickit::Style::on_style_load( sub { undef %KEYS_BY_TYPE_CLASS_TAG } );

sub set_style_tag
{
   my $self = shift;
   my ( $tag, $value ) = @_;

   # Early-return on no change
   return if !$self->{style_tag}{$tag} == !$value;

   # Work out what style keys might depend on this tag
   my %values;

   if( $self->{style_direct} ) {
      KEYSET: foreach my $keyset ( $self->{style_direct}->keysets ) {
         $keyset->tags->{$tag} or next KEYSET;

         $values{$_} ||= [] for keys %{ $keyset->style };
      }
   }

   my $type = $self->_widget_style_type;
   foreach my $class ( $self->style_classes, undef ) {
      my $keys = $KEYS_BY_TYPE_CLASS_TAG{$type}{$class//""}{$tag} ||= do {
         my $tagset = Tickit::Style::_ref_tagset( $type, $class );

         my %keys;
         KEYSET: foreach my $keyset ( $tagset->keysets ) {
            $keyset->tags->{$tag} or next KEYSET;

            $keys{$_}++ for keys %{ $keyset->style };
         }

         [ keys %keys ];
      };

      $values{$_} ||= [] for @$keys;
   }

   my @keys = keys %values;

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

   $self->{style_tag}{$tag} = !!$value;

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

sub _style_tags
{
   my $self = shift;
   my $tags = $self->{style_tag};
   return join "|", sort grep { $tags->{$_} } keys %$tags;
}