view release on metacpan or  search on metacpan

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

my $new = __PACKAGE__->can( "new" );
*new = sub {
   my $class = shift;
   my %args = @_;

   exists $args{$_} and $args{style}{$_} = delete $args{$_} for qw( spacing );

   return $class->$new( %args );
};

method BUILD
{
   my %args = @_;

   $self->add( $_ ) for $args{children}->@*;
}

=head1 METHODS

=cut

=head2 @children = $widget->children

In scalar context, returns the number of contained children. In list context,
returns a list of all the child widgets.

=cut

method children
{
   return @_children;
}

method _any2index
{
   if( ref $_[0] ) {
      my $child = shift;
      $_children[$_] == $child and return $_ for 0 .. $#_children;
      croak "Unable to find child $child";
   }
   else {
      my $index = shift;
      return $index if $index >= 0 and $index < scalar @_children;
      croak "Index $index out of bounds";
   }
}

=head2 %opts = $widget->child_opts( $child_or_index )

Returns the options currently set for the given child, specified either by
reference or by index.

=cut

method child_opts
{
   my $child = ref $_[0] ? shift : $_children[shift];

   return unless $child;

   return $self->SUPER::child_opts( $child );
}

=head2 $widget->set_child( $index, $child )

Replaces the child widget at the given index with the given new one;
preserving any options that are set on it.

=cut

method set_child
{
   my ( $index, $child ) = @_;

   my $old_child = $_children[$index];

   my %opts;
   if( $old_child ) {
      %opts = $self->child_opts( $old_child );

      dynamically $self->{suppress_redistribute} = 1;
      $self->SUPER::remove( $old_child );
   }

   $_children[$index] = $child;

   $self->SUPER::add( $child, %opts );
}

=head2 $widget->set_child_opts( $child_or_index, %newopts )

Sets new options on the given child, specified either by reference or by
index. Any options whose value is given as C<undef> are deleted.

=cut

method set_child_opts
{
   my $child = ref $_[0] ? shift : $_children[shift];

   return unless $child;

   return $self->SUPER::set_child_opts( $child, @_ );
}

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

   $rb->eraserect( $rect );
}

=head2 $widget->add( $child, %opts )

Adds the widget as a new child of this one, with the given options

=cut

method add
{
   my ( $child, %opts ) = @_;

   push @_children, $child;

   $self->SUPER::add( $child,
      expand     => $opts{expand} || 0,
      force_size => $opts{force_size},
   );
}

=head2 $widget->remove( $child_or_index )

Removes the given child widget if present, by reference or index

=cut

method remove
{
   my $index = $self->_any2index( shift );

   my ( $child ) = splice @_children, $index, 1, ();

   $self->SUPER::remove( $child ) if $child;
}

method reshape
{
   $self->{suppress_redistribute} and return;

   my $window = $self->window;

   return unless $self->children;

   my $spacing = $self->get_style_values( "spacing" );

   my @buckets;
   foreach my $child ( $self->children ) {
      my %opts = $self->child_opts( $child );

      push @buckets, {
         fixed => $spacing,
      } if @buckets; # gap

      my $base = defined $opts{force_size} ? $opts{force_size}
                                           : $self->get_child_base( $child );
      warn "Child $child did not define a base size for $self\n", $base = 0
         unless defined $base;

      push @buckets, {
         base   => $base,
         expand => $opts{expand},
         child  => $child,
      };
   }

   distribute( $self->get_total_quota( $window ), @buckets );

   foreach my $b ( @buckets ) {
      my $child = $b->{child} or next;

      $self->set_child_window( $child, $b->{start}, $b->{value}, $window );
   }

   $self->redraw;
}

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;