File Coverage

blib/lib/Tickit/Widget/LinearSplit.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::LinearSplit;
7              
8 1     1   4 use strict;
  1         1  
  1         20  
9 1     1   3 use warnings;
  1         1  
  1         20  
10 1     1   2 use base qw( Tickit::ContainerWidget );
  1         1  
  1         124  
11             use Tickit::Window 0.32; # needs drag_start
12              
13             our $VERSION = '0.27';
14              
15             use Carp;
16              
17             sub new
18             {
19             my $class = shift;
20             my %args = @_;
21              
22             my $self = $class->SUPER::new( %args );
23              
24             $self->{split_fraction} = 0.5;
25              
26             return $self;
27             }
28              
29             sub A_child
30             {
31             my $self = shift;
32             $self->{A_child};
33             }
34              
35             sub set_A_child
36             {
37             my $self = shift;
38             my ( $child ) = @_;
39             $self->remove( $self->{A_child} ) if $self->{A_child};
40             $self->add( $self->{A_child} = $child );
41             }
42              
43             sub B_child
44             {
45             my $self = shift;
46             $self->{B_child};
47             }
48              
49             sub set_B_child
50             {
51             my $self = shift;
52             my ( $child ) = @_;
53             $self->remove( $self->{B_child} ) if $self->{B_child};
54             $self->add( $self->{B_child} = $child );
55             }
56              
57             sub children
58             {
59             my $self = shift;
60             return grep { defined } $self->{A_child}, $self->{B_child};
61             }
62              
63             sub child_resized
64             {
65             my $self = shift;
66             # TODO: should handle minimums at least
67             }
68              
69             ## This should come from ContainerWidget
70             sub children_changed
71             {
72             my $self = shift;
73              
74             $self->reshape if $self->window;
75             $self->resized;
76             }
77             ##
78              
79             sub reshape
80             {
81             my $self = shift;
82             my $win = $self->window or return;
83              
84             my $spacing = $self->get_style_values( "spacing" );
85              
86             my $method = $self->VALUE_METHOD;
87              
88             my $quota = $win->$method - $spacing;
89             my $want_split_at = int( $quota * $self->{split_fraction} + 0.5 ); # round to nearest
90              
91             # Enforce child minimum sizes
92             if( my $child = $self->{B_child} ) {
93             my $max = $quota - $child->$method;
94             $want_split_at = $max if $want_split_at > $max;
95             }
96             if( my $child = $self->{A_child} ) {
97             my $min = $child->$method;
98             $want_split_at = $min if $want_split_at < $min;
99             }
100              
101             my $A_value = $want_split_at;
102             my $B_value = $quota - $want_split_at;
103              
104             my @A_geom = $self->_make_child_geom( 0, $A_value );
105             my @B_geom = $self->_make_child_geom( $A_value + $spacing, $B_value );
106              
107             if( my $child = $self->{A_child} ) {
108             if( $A_value > 0 ) {
109             if( my $childwin = $child->window ) {
110             $childwin->change_geometry( @A_geom );
111             }
112             else {
113             $child->set_window( $win->make_sub( @A_geom ) );
114             }
115             }
116             else {
117             $child->set_window( undef );
118             }
119             }
120              
121             if( my $child = $self->{B_child} ) {
122             if( $B_value > 0 ) {
123             if( my $childwin = $child->window ) {
124             $childwin->change_geometry( @B_geom );
125             }
126             else {
127             $child->set_window( $win->make_sub( @B_geom ) );
128             }
129             }
130             else {
131             $child->set_window( undef );
132             }
133             }
134              
135             $self->{split_at} = $A_value;
136             $self->{split_len} = $spacing;
137             }
138              
139             sub _on_mouse
140             {
141             my $self = shift;
142             my ( $ev, $val ) = @_;
143              
144             my $val0 = $val - $self->{split_at};
145             my $in_split = $val0 >= 0 && $val0 < $self->{split_len};
146              
147             if( $ev eq "press" ) {
148             $self->set_style_tag( active => 1 ) if $in_split;
149             }
150             elsif( $ev eq "drag_start" ) {
151             return unless $in_split;
152             $self->{drag_mouse_offset} = $val0;
153             return 1;
154             }
155             elsif( $ev eq "drag" ) {
156             return unless defined $self->{drag_mouse_offset};
157              
158             my $method = $self->VALUE_METHOD;
159              
160             my $quota = $self->window->$method - $self->{split_len};
161              
162             my $want_split_at = $val - $self->{drag_mouse_offset};
163             $self->{split_fraction} = $want_split_at / $quota;
164              
165             $self->reshape;
166             $self->redraw;
167             }
168             elsif( $ev eq "drag_drop" ) {
169             undef $self->{drag_mouse_offset};
170             }
171             elsif( $ev eq "release" ) {
172             $self->set_style_tag( active => 0 ) if $in_split;
173             }
174             }
175              
176             0x55AA;