File Coverage

blib/lib/Tickit/Widget/VBox.pm
Criterion Covered Total %
statement 9 9 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 12 12 100.0


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2009-2017 -- leonerd@leonerd.org.uk
5              
6             package Tickit::Widget::VBox;
7              
8 1     1   766 use strict;
  1         1  
  1         21  
9 1     1   3 use warnings;
  1         1  
  1         19  
10 1     1   2 use base qw( Tickit::Widget::LinearBox );
  1         1  
  1         81  
11             use Tickit::Style;
12              
13             our $VERSION = '0.47';
14              
15             use List::Util qw( sum max );
16              
17             =head1 NAME
18              
19             C - distribute child widgets in a vertical column
20              
21             =head1 SYNOPSIS
22              
23             use Tickit;
24             use Tickit::Widget::VBox;
25             use Tickit::Widget::Static;
26              
27             my $vbox = Tickit::Widget::VBox->new;
28              
29             foreach my $position (qw( top middle bottom )) {
30             $vbox->add(
31             Tickit::Widget::Static->new(
32             text => $position,
33             align => "centre",
34             valign => $position,
35             ),
36             expand => 1
37             );
38             }
39              
40             Tickit->new( root => $vbox )->run;
41              
42             =head1 DESCRIPTION
43              
44             This subclass of L distributes its children in a
45             vertical column. Its width will be the width of the widest child, and its
46             height will be the sum of the heights of all the children, plus the
47             inter-child spacing.
48              
49             =head1 STYLE
50              
51             The default style pen is used as the widget pen.
52              
53             Note that while the widget pen is mutable and changes to it will result in
54             immediate redrawing, any changes made will be lost if the widget style is
55             changed.
56              
57             The following style keys are used:
58              
59             =over 4
60              
61             =item spacing => INT
62              
63             The number of lines of spacing between children
64              
65             =back
66              
67             =cut
68              
69             style_definition base =>
70             spacing => 0;
71              
72             style_reshape_keys qw( spacing );
73              
74             use constant WIDGET_PEN_FROM_STYLE => 1;
75              
76             sub lines
77             {
78             my $self = shift;
79             my $spacing = $self->get_style_values( "spacing" );
80             return ( sum( map { $_->requested_lines } $self->children ) || 1 ) +
81             $spacing * ( $self->children - 1 );
82             }
83              
84             sub cols
85             {
86             my $self = shift;
87             return max( 1, map { $_->requested_cols } $self->children );
88             }
89              
90             sub get_total_quota
91             {
92             my $self = shift;
93             my ( $window ) = @_;
94             return $window->lines;
95             }
96              
97             sub get_child_base
98             {
99             my $self = shift;
100             my ( $child ) = @_;
101             return $child->requested_lines;
102             }
103              
104             sub set_child_window
105             {
106             my $self = shift;
107             my ( $child, $top, $lines, $window ) = @_;
108              
109             if( $window and $lines ) {
110             if( my $childwin = $child->window ) {
111             $childwin->change_geometry( $top, 0, $lines, $window->cols );
112             }
113             else {
114             my $childwin = $window->make_sub( $top, 0, $lines, $window->cols );
115             $child->set_window( $childwin );
116             }
117             }
118             else {
119             if( my $childwin = $child->window ) {
120             $child->set_window( undef );
121             $childwin->close;
122             }
123             }
124             }
125              
126             =head1 AUTHOR
127              
128             Paul Evans
129              
130             =cut
131              
132             0x55AA;