File Coverage

blib/lib/Tickit/Widget/VSplit.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, 2013 -- leonerd@leonerd.org.uk
5              
6             package Tickit::Widget::VSplit;
7              
8 1     1   779 use strict;
  1         1  
  1         22  
9 1     1   2 use warnings;
  1         27  
  1         23  
10 1     1   6 use base qw( Tickit::Widget::LinearSplit );
  1         1  
  1         129  
11             use Tickit::Style;
12             use Tickit::RenderBuffer qw( LINE_SINGLE CAP_BOTH );
13              
14             our $VERSION = '0.27';
15              
16             use Carp;
17              
18             use List::Util qw( sum max );
19              
20             =head1 NAME
21              
22             C - an adjustable vertical split between two widgets
23              
24             =head1 SYNOPSIS
25              
26             use Tickit;
27             use Tickit::Widget::VSplit;
28             use Tickit::Widget::Static;
29              
30             my $vsplit = Tickit::Widget::VSplit->new(
31             left_child => Tickit::Widget::Static->new( text => "Text above" ),
32             right_child => Tickit::Widget::Static->new( text => "Text below" ),
33             );
34              
35             Tickit->new( root => $vsplit )->run;
36              
37             =head1 DESCRIPTION
38              
39             This container widget holds two child widgets, displayed side by side. The two
40             widgets are displayed with a vertical split bar between them, which reacts to
41             mouse click-drag events, allowing the user to adjust the proportion of space
42             given to the two widgets.
43              
44             =head1 STYLE
45              
46             The default style pen is used as the widget pen. The following style pen
47             prefixes are also used:
48              
49             =over 4
50              
51             =item split => PEN
52              
53             The pen used to render the vertical split area
54              
55             =back
56              
57             The following style keys are used:
58              
59             =over 4
60              
61             =item spacing => INT
62              
63             The number of columns of spacing between the left and right child widgets
64              
65             =back
66              
67             The following style tags are used:
68              
69             =over 4
70              
71             =item :active
72              
73             Set when a mouse drag resize operation is occurring
74              
75             =back
76              
77             =cut
78              
79             style_definition base =>
80             split_fg => "white",
81             split_bg => "blue",
82             spacing => 1;
83              
84             style_definition ':active' =>
85             split_fg => "hi-white",
86             split_b => 1;
87              
88             style_reshape_keys qw( spacing );
89              
90             use constant WIDGET_PEN_FROM_STYLE => 1;
91              
92             use constant VALUE_METHOD => "cols";
93              
94             =head1 CONSTRUCTOR
95              
96             =head2 $vsplit = Tickit::Widget::VSplit->new( %args )
97              
98             Constructs a new C object.
99              
100             Takes the following named arguments
101              
102             =over 8
103              
104             =item left_child => WIDGET
105              
106             =item right_child => WIDGET
107              
108             Child widgets to use
109              
110             =back
111              
112             =cut
113              
114             sub new
115             {
116             my $class = shift;
117             my %args = @_;
118              
119             my $self = $class->SUPER::new( %args );
120              
121             $self->set_left_child ( $args{left_child} ) if $args{left_child};
122             $self->set_right_child( $args{right_child} ) if $args{right_child};
123              
124             return $self;
125             }
126              
127             sub lines
128             {
129             my $self = shift;
130             return max(
131             $self->{A_child} ? $self->{A_child}->requested_lines : 1,
132             $self->{B_child} ? $self->{B_child}->requested_lines : 1,
133             );
134             }
135              
136             sub cols
137             {
138             my $self = shift;
139             my $spacing = $self->get_style_values( "spacing" );
140             return sum(
141             $self->{A_child} ? $self->{A_child}->requested_cols : 1,
142             $spacing,
143             $self->{B_child} ? $self->{B_child}->requested_cols : 1,
144             );
145             }
146              
147             =head1 ACCESSORS
148              
149             =cut
150              
151             =head2 $child = $hsplit->left_child
152              
153             =head2 $vsplit->set_left_child( $child )
154              
155             Accessor for the child widget used in the left half of the display.
156              
157             =cut
158              
159             *left_child = __PACKAGE__->can( "A_child" );
160             *set_left_child = __PACKAGE__->can( "set_A_child" );
161              
162             =head2 $child = $hsplit->right_child
163              
164             =head2 $vsplit->set_right_child( $child )
165              
166             Accessor for the child widget used in the right half of the display.
167              
168             =cut
169              
170             *right_child = __PACKAGE__->can( "B_child" );
171             *set_right_child = __PACKAGE__->can( "set_B_child" );
172              
173             sub _make_child_geom
174             {
175             my $self = shift;
176             my ( $start, $len ) = @_;
177             return ( 0, $start, $self->window->lines, $len );
178             }
179              
180             sub render_to_rb
181             {
182             my $self = shift;
183             my ( $rb, $rect ) = @_;
184              
185             my $split_len = $self->{split_len};
186              
187             my $lines = $self->window->lines;
188              
189             $rb->setpen( $self->get_style_pen( "split" ) );
190              
191             $rb->vline_at( 0, $lines-1, $self->{split_at}, LINE_SINGLE, undef, CAP_BOTH );
192              
193             if( $split_len > 2 ) {
194             foreach my $line ( $rect->linerange ) {
195             $rb->erase_at( $line, $self->{split_at} + 1, $split_len - 2 );
196             }
197             }
198             if( $split_len > 1 ) {
199             $rb->vline_at( 0, $lines-1, $self->{split_at} + $split_len - 1, LINE_SINGLE, undef, CAP_BOTH );
200             }
201             }
202              
203             sub on_mouse
204             {
205             my $self = shift;
206             my ( $args ) = @_;
207              
208             if( $args->type ne "wheel" and $args->button == 1 ) {
209             return $self->_on_mouse( $args->type, $args->col );
210             }
211             return;
212             }
213              
214             =head1 AUTHOR
215              
216             Paul Evans
217              
218             =cut
219              
220             0x55AA;