File Coverage

blib/lib/Tickit/Widget/HSplit.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::HSplit;
7              
8 1     1   792 use strict;
  1         2  
  1         21  
9 1     1   3 use warnings;
  1         1  
  1         24  
10 1     1   5 use base qw( Tickit::Widget::LinearSplit );
  1         2  
  1         327  
11             use Tickit::Style;
12             use Tickit::RenderBuffer qw( LINE_SINGLE CAP_BOTH );
13              
14             our $VERSION = '0.25';
15              
16             use Carp;
17              
18             use List::Util qw( sum max );
19              
20             =head1 NAME
21              
22             C - an adjustable horizontal split between two widgets
23              
24             =head1 SYNOPSIS
25              
26             use Tickit;
27             use Tickit::Widget::HSplit;
28             use Tickit::Widget::Static;
29              
30             my $hsplit = Tickit::Widget::HSplit->new(
31             top_child => Tickit::Widget::Static->new( text => "Text above" ),
32             bottom_child => Tickit::Widget::Static->new( text => "Text below" ),
33             );
34              
35             Tickit->new( root => $hsplit )->run;
36              
37             =head1 DESCRIPTION
38              
39             This container widget holds two child widgets, displayed one above the other.
40             The two widgets are displayed with a horizontal split bar between them, which
41             reacts to mouse click-drag events, allowing the user to adjust the proportion
42             of space 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 horizontal 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 lines of spacing between the top and bottom 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 => "lines";
93              
94             =head1 CONSTRUCTOR
95              
96             =head2 $hsplit = Tickit::Widget::HSplit->new( %args )
97              
98             Constructs a new C object.
99              
100             Takes the following named arguments
101              
102             =over 8
103              
104             =item top_child => WIDGET
105              
106             =item bottom_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_top_child ( $args{top_child} ) if $args{top_child};
122             $self->set_bottom_child( $args{bottom_child} ) if $args{bottom_child};
123              
124             return $self;
125             }
126              
127             sub lines
128             {
129             my $self = shift;
130             my $spacing = $self->get_style_values( "spacing" );
131             return sum(
132             $self->{A_child} ? $self->{A_child}->requested_lines : 1,
133             $spacing,
134             $self->{B_child} ? $self->{B_child}->requested_lines : 1,
135             );
136             }
137              
138             sub cols
139             {
140             my $self = shift;
141             return max(
142             $self->{A_child} ? $self->{A_child}->requested_cols : 1,
143             $self->{B_child} ? $self->{B_child}->requested_cols : 1,
144             );
145             }
146              
147             =head1 ACCESSORS
148              
149             =cut
150              
151             =head2 $child = $hsplit->top_child
152              
153             =head2 $hsplit->set_top_child( $child )
154              
155             Accessor for the child widget used in the top half of the display.
156              
157             =cut
158              
159             *top_child = __PACKAGE__->can( "A_child" );
160             *set_top_child = __PACKAGE__->can( "set_A_child" );
161              
162             =head2 $child = $hsplit->bottom_child
163              
164             =head2 $hsplit->set_bottom_child( $child )
165              
166             Accessor for the child widget used in the bottom half of the display.
167              
168             =cut
169              
170             *bottom_child = __PACKAGE__->can( "B_child" );
171             *set_bottom_child = __PACKAGE__->can( "set_B_child" );
172              
173             sub _make_child_geom
174             {
175             my $self = shift;
176             my ( $start, $len ) = @_;
177             return ( $start, 0, $len, $self->window->cols );
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 $cols = $self->window->cols;
188              
189             $rb->setpen( $self->get_style_pen( "split" ) );
190              
191             $rb->hline_at( $self->{split_at}, 0, $cols-1, LINE_SINGLE, undef, CAP_BOTH );
192              
193             foreach my $line ( $rect->linerange( 1, $split_len-2 ) ) {
194             $rb->erase_at( $self->{split_at} + $line, 0, $cols );
195             }
196              
197             if( $split_len > 1 ) {
198             $rb->hline_at( $self->{split_at} + $split_len - 1, 0, $cols-1, LINE_SINGLE, undef, CAP_BOTH );
199             }
200             }
201              
202             sub on_mouse
203             {
204             my $self = shift;
205             my ( $args ) = @_;
206              
207             return unless $args->button == 1;
208             return $self->_on_mouse( $args->type, $args->line );
209             }
210              
211             =head1 AUTHOR
212              
213             Paul Evans
214              
215             =cut
216              
217             0x55AA;